mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
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>
This commit is contained in:
Diogo
GitHub
@@ -605,7 +605,7 @@ directoryService st DirectoryOpts {superUsers, serviceName, searchResults, testi
|
||||
listGroups count pending =
|
||||
readTVarIO (groupRegs st) >>= \groups -> do
|
||||
grs <-
|
||||
if pending
|
||||
if pending
|
||||
then filterM (fmap pendingApproval . readTVarIO . groupRegStatus) groups
|
||||
else pure groups
|
||||
sendReply $ show (length grs) <> " registered group(s)" <> (if length grs > count then ", showing the last " <> show count else "")
|
||||
@@ -643,7 +643,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)
|
||||
|
||||
+7
-6
@@ -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, gap) <- withFastStore (\db -> getDirectChat db vr user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTDirect directChat) gap
|
||||
CTGroup -> do
|
||||
groupChat <- withFastStore (\db -> getGroupChat db vr user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTGroup groupChat)
|
||||
(groupChat, gap) <- withFastStore (\db -> getGroupChat db vr user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTGroup groupChat) gap
|
||||
CTLocal -> do
|
||||
localChat <- withFastStore (\db -> getLocalChat db user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTLocal localChat)
|
||||
(localChat, gap) <- withFastStore (\db -> getLocalChat db user cId pagination search)
|
||||
pure $ CRApiChat user (AChat SCTLocal localChat) gap
|
||||
CTContactRequest -> pure $ chatCmdError (Just user) "not implemented"
|
||||
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
|
||||
APIGetChatItems pagination search -> withUser $ \user -> do
|
||||
@@ -8302,6 +8302,7 @@ chatCommandP =
|
||||
<|> (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)
|
||||
|
||||
@@ -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, gap :: Maybe ChatGap}
|
||||
| CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]}
|
||||
| CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
|
||||
| CRChatItemId User (Maybe ChatItemId)
|
||||
@@ -840,8 +840,11 @@ data ChatPagination
|
||||
| CPAfter ChatItemId Int
|
||||
| CPBefore ChatItemId Int
|
||||
| CPAround ChatItemId Int
|
||||
| CPInitial Int
|
||||
deriving (Show)
|
||||
|
||||
type ChatGap = Int
|
||||
|
||||
data PaginationByTime
|
||||
= PTLast Int
|
||||
| PTAfter UTCTime Int
|
||||
|
||||
@@ -138,7 +138,7 @@ import Data.Time (addUTCTime)
|
||||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Database.SQLite.Simple (NamedParam (..), Only (..), Query, (:.) (..))
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
import Simplex.Chat.Controller (ChatListQuery (..), ChatPagination (..), PaginationByTime (..))
|
||||
import Simplex.Chat.Controller (ChatGap, ChatListQuery (..), ChatPagination (..), PaginationByTime (..))
|
||||
import Simplex.Chat.Markdown
|
||||
import Simplex.Chat.Messages
|
||||
import Simplex.Chat.Messages.CIContent
|
||||
@@ -947,38 +947,61 @@ 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 ChatGap)
|
||||
getDirectChat db vr user contactId pagination search_ = do
|
||||
let search = fromMaybe "" search_
|
||||
ct <- getContact db vr user contactId
|
||||
case pagination of
|
||||
CPLast count -> liftIO $ getDirectChatLast_ db user ct count search
|
||||
CPLast count -> liftIO $ (,Nothing) <$> 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
|
||||
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_
|
||||
chatItemIds <- getDirectChatItemIdsLast_ db user ct count search
|
||||
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)
|
||||
|
||||
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)
|
||||
|
||||
getDirectChatItemGapToLatest_ :: DB.Connection -> User -> Contact -> CChatItem 'CTDirect -> String -> IO Int
|
||||
getDirectChatItemGapToLatest_ db User {userId} Contact {contactId} chatItem search = do
|
||||
count <-
|
||||
maybeFirstRow fromOnly $
|
||||
DB.queryNamed
|
||||
db
|
||||
[sql|
|
||||
SELECT COUNT(1)
|
||||
FROM chat_items
|
||||
WHERE user_id = :userId AND contact_id = :contactId AND item_text LIKE '%' || :search || '%'
|
||||
AND (created_at > :itemCreatedAt OR (created_at = :itemCreatedAt AND chat_item_id > :chatItemId))
|
||||
|]
|
||||
[ ":userId" := userId,
|
||||
":contactId" := contactId,
|
||||
":search" := search,
|
||||
":itemCreatedAt" := chatItemCreatedAt chatItem,
|
||||
":chatItemId" := cchatItemId chatItem
|
||||
]
|
||||
pure $ maybe 0 (\c -> max 0 (c - 1)) count
|
||||
|
||||
safeGetDirectItem :: DB.Connection -> User -> Contact -> UTCTime -> ChatItemId -> IO (CChatItem 'CTDirect)
|
||||
safeGetDirectItem db user ct currentTs itemId =
|
||||
@@ -1022,14 +1045,16 @@ getDirectChatItemLast db user@User {userId} contactId = do
|
||||
(userId, contactId)
|
||||
getDirectChatItem db user contactId chatItemId
|
||||
|
||||
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect, Maybe ChatGap)
|
||||
getDirectChatAfter_ db user ct@Contact {contactId} afterChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
afterChatItem <- getDirectChatItem db user contactId afterChatItemId
|
||||
chatItemIds <- liftIO $ getDirectChatItemIdsAfter_ db user ct afterChatItemId count search (chatItemCreatedAt afterChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetDirectItem db user ct currentTs) chatItemIds
|
||||
pure $ Chat (DirectChat ct) chatItems stats
|
||||
gapToLatest <- liftIO $ getDirectChatItemGapToLatest_ db user ct (last chatItems) search
|
||||
let chatGap = if gapToLatest > 0 then Just gapToLatest else Nothing
|
||||
pure (Chat (DirectChat ct) chatItems stats, chatGap)
|
||||
|
||||
getDirectChatItemIdsAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getDirectChatItemIdsAfter_ db User {userId} Contact {contactId} afterChatItemId count search afterChatItemCreatedAt =
|
||||
@@ -1046,14 +1071,14 @@ getDirectChatItemIdsAfter_ db User {userId} Contact {contactId} afterChatItemId
|
||||
|]
|
||||
(userId, contactId, search, afterChatItemCreatedAt, afterChatItemCreatedAt, afterChatItemId, count)
|
||||
|
||||
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect, Maybe ChatGap)
|
||||
getDirectChatBefore_ db user ct@Contact {contactId} beforeChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
beforeChatItem <- getDirectChatItem db user contactId beforeChatItemId
|
||||
chatItemIds <- liftIO $ getDirectChatItemsIdsBefore_ db user ct beforeChatItemId count search (chatItemCreatedAt beforeChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetDirectItem db user ct currentTs) chatItemIds
|
||||
pure $ Chat (DirectChat ct) (reverse chatItems) stats
|
||||
pure (Chat (DirectChat ct) (reverse chatItems) stats, Nothing)
|
||||
|
||||
getDirectChatItemsIdsBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getDirectChatItemsIdsBefore_ db User {userId} Contact {contactId} beforeChatItemId count search beforeChatItemCreatedAt =
|
||||
@@ -1070,7 +1095,7 @@ getDirectChatItemsIdsBefore_ db User {userId} Contact {contactId} beforeChatItem
|
||||
|]
|
||||
(userId, contactId, search, beforeChatItemCreatedAt, beforeChatItemCreatedAt, beforeChatItemId, count)
|
||||
|
||||
getDirectChatAround_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect)
|
||||
getDirectChatAround_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTDirect, Maybe ChatGap)
|
||||
getDirectChatAround_ db user ct@Contact {contactId} aroundItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
let (fetchCountBefore, fetchCountAfter) = divideFetchCountAround_ (count - 1)
|
||||
@@ -1081,39 +1106,100 @@ getDirectChatAround_ db user ct@Contact {contactId} aroundItemId count search =
|
||||
beforeChatItems <- liftIO $ reverse <$> mapM (safeGetDirectItem db user ct currentTs) beforeIds
|
||||
afterChatItems <- liftIO $ mapM (safeGetDirectItem db user ct currentTs) afterIds
|
||||
let chatItems = beforeChatItems <> [middleChatItem] <> afterChatItems
|
||||
pure $ Chat (DirectChat ct) chatItems stats
|
||||
gapToLatest <- liftIO $ getDirectChatItemGapToLatest_ db user ct (last chatItems) search
|
||||
let chatGap = if gapToLatest > 0 then Just gapToLatest else Nothing
|
||||
pure (Chat (DirectChat ct) chatItems stats, chatGap)
|
||||
|
||||
getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getDirectChatInitial_ :: DB.Connection -> User -> Contact -> Int -> ExceptT StoreError IO (Chat 'CTDirect, Maybe ChatGap)
|
||||
getDirectChatInitial_ db user@User {userId} ct@Contact {contactId} count = do
|
||||
firstUnreadItemId_ <- liftIO getDirectChatMinUnreadItemId_
|
||||
case firstUnreadItemId_ of
|
||||
Just firstUnreadItemId -> do
|
||||
(chat, gap) <- getDirectChatAround_ db user ct firstUnreadItemId count ""
|
||||
case gap of
|
||||
Just size -> do
|
||||
if size > snd (divideFetchCountAround_ count)
|
||||
then getLatestItems_ chat size
|
||||
else pure (chat, Nothing)
|
||||
Nothing -> pure (chat, Nothing)
|
||||
Nothing -> liftIO $ (,Nothing) <$> getDirectChatLast_ db user ct count ""
|
||||
where
|
||||
getLatestItems_ :: Chat 'CTDirect -> Int -> ExceptT StoreError IO (Chat 'CTDirect, Maybe ChatGap)
|
||||
getLatestItems_ c@Chat {chatItems} gapToLatest = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
latestItemIds <- liftIO $ getDirectChatItemIdsLast_ db user ct (min count gapToLatest) ""
|
||||
latestItems <- liftIO $ mapM (safeGetDirectItem db user ct currentTs) latestItemIds
|
||||
let allItems = chatItems <> latestItems
|
||||
let chat = c {chatItems = allItems}
|
||||
if gapToLatest > length latestItems
|
||||
then pure (chat, Just $ gapToLatest - length latestItems)
|
||||
else pure (chat, Nothing)
|
||||
getDirectChatMinUnreadItemId_ :: IO (Maybe ChatItemId)
|
||||
getDirectChatMinUnreadItemId_ =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT MIN(chat_item_id)
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND contact_id = ? AND item_status = ?
|
||||
|]
|
||||
(userId, contactId, CISRcvNew)
|
||||
|
||||
getGroupChat :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTGroup, Maybe ChatGap)
|
||||
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
|
||||
CPLast count -> liftIO $ (,Nothing) <$> 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
|
||||
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_
|
||||
chatItemIds <- getGroupChatItemIdsLast_ db user g count search
|
||||
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)
|
||||
|
||||
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)
|
||||
|
||||
getGroupChatItemGapToLatest_ :: DB.Connection -> User -> GroupInfo -> CChatItem 'CTGroup -> String -> IO Int
|
||||
getGroupChatItemGapToLatest_ db User {userId} GroupInfo {groupId} chatItem search = do
|
||||
count <-
|
||||
maybeFirstRow fromOnly $
|
||||
DB.queryNamed
|
||||
db
|
||||
[sql|
|
||||
SELECT COUNT(1)
|
||||
FROM chat_items
|
||||
WHERE user_id = :userId AND group_id = :groupId AND item_text LIKE '%' || :search || '%'
|
||||
AND (created_at > :itemCreatedAt OR (created_at = :itemCreatedAt AND chat_item_id > :chatItemId))
|
||||
|]
|
||||
[ ":userId" := userId,
|
||||
":groupId" := groupId,
|
||||
":search" := search,
|
||||
":itemCreatedAt" := chatItemCreatedAt chatItem,
|
||||
":chatItemId" := cchatItemId chatItem
|
||||
]
|
||||
pure $ maybe 0 (\c -> max 0 (c - 1)) count
|
||||
|
||||
safeGetGroupItem :: DB.Connection -> User -> GroupInfo -> UTCTime -> ChatItemId -> IO (CChatItem 'CTGroup)
|
||||
safeGetGroupItem db user g currentTs itemId =
|
||||
@@ -1157,14 +1243,16 @@ getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do
|
||||
(userId, groupId, groupMemberId)
|
||||
getGroupChatItem db user groupId chatItemId
|
||||
|
||||
getGroupChatAfter_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getGroupChatAfter_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup, Maybe ChatGap)
|
||||
getGroupChatAfter_ db user g@GroupInfo {groupId} afterChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
afterChatItem <- getGroupChatItem db user groupId afterChatItemId
|
||||
chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ db user g afterChatItemId count search (chatItemTs afterChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds
|
||||
pure $ Chat (GroupChat g) chatItems stats
|
||||
gapToLatest <- liftIO $ getGroupChatItemGapToLatest_ db user g (head chatItems) search
|
||||
let chatGap = if gapToLatest > 0 then Just gapToLatest else Nothing
|
||||
pure (Chat (GroupChat g) chatItems stats, chatGap)
|
||||
|
||||
getGroupChatItemIdsAfter_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getGroupChatItemIdsAfter_ db User {userId} GroupInfo {groupId} afterChatItemId count search afterChatItemTs =
|
||||
@@ -1181,14 +1269,14 @@ getGroupChatItemIdsAfter_ db User {userId} GroupInfo {groupId} afterChatItemId c
|
||||
|]
|
||||
(userId, groupId, search, afterChatItemTs, afterChatItemTs, afterChatItemId, count)
|
||||
|
||||
getGroupChatBefore_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getGroupChatBefore_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup, Maybe ChatGap)
|
||||
getGroupChatBefore_ db user g@GroupInfo {groupId} beforeChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId
|
||||
chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ db user g beforeChatItemId count search (chatItemTs beforeChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) chatItemIds
|
||||
pure $ Chat (GroupChat g) (reverse chatItems) stats
|
||||
pure (Chat (GroupChat g) (reverse chatItems) stats, Nothing)
|
||||
|
||||
getGroupChatItemIdsBefore_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getGroupChatItemIdsBefore_ db User {userId} GroupInfo {groupId} beforeChatItemId count search beforeChatItemTs =
|
||||
@@ -1205,7 +1293,7 @@ getGroupChatItemIdsBefore_ db User {userId} GroupInfo {groupId} beforeChatItemId
|
||||
|]
|
||||
(userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count)
|
||||
|
||||
getGroupChatAround_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup)
|
||||
getGroupChatAround_ :: DB.Connection -> User -> GroupInfo -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTGroup, Maybe ChatGap)
|
||||
getGroupChatAround_ db user g@GroupInfo {groupId} aroundItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
let (fetchCountBefore, fetchCountAfter) = divideFetchCountAround_ (count - 1)
|
||||
@@ -1216,39 +1304,100 @@ getGroupChatAround_ db user g@GroupInfo {groupId} aroundItemId count search = do
|
||||
beforeChatItems <- liftIO $ reverse <$> mapM (safeGetGroupItem db user g currentTs) beforeIds
|
||||
afterChatItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) afterIds
|
||||
let chatItems = beforeChatItems <> [middleChatItem] <> afterChatItems
|
||||
pure $ Chat (GroupChat g) chatItems stats
|
||||
gapToLatest <- liftIO $ getGroupChatItemGapToLatest_ db user g (last chatItems) search
|
||||
let chatGap = if gapToLatest > 0 then Just gapToLatest else Nothing
|
||||
pure (Chat (GroupChat g) chatItems stats, chatGap)
|
||||
|
||||
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getGroupChatInitial_ :: DB.Connection -> User -> GroupInfo -> Int -> ExceptT StoreError IO (Chat 'CTGroup, Maybe ChatGap)
|
||||
getGroupChatInitial_ db user@User {userId} g@GroupInfo {groupId} count = do
|
||||
firstUnreadItemId_ <- liftIO getGroupChatMinUnreadItemId_
|
||||
case firstUnreadItemId_ of
|
||||
Just firstUnreadItemId -> do
|
||||
(chat, gap) <- getGroupChatAround_ db user g firstUnreadItemId count ""
|
||||
case gap of
|
||||
Just size -> do
|
||||
if size > snd (divideFetchCountAround_ count)
|
||||
then getLatestItems_ chat size
|
||||
else pure (chat, Nothing)
|
||||
Nothing -> pure (chat, Nothing)
|
||||
Nothing -> liftIO $ (,Nothing) <$> getGroupChatLast_ db user g count ""
|
||||
where
|
||||
getGroupChatMinUnreadItemId_ :: IO (Maybe ChatItemId)
|
||||
getGroupChatMinUnreadItemId_ =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT MIN(chat_item_id)
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND group_id = ? AND item_status = ?
|
||||
|]
|
||||
(userId, groupId, CISRcvNew)
|
||||
getLatestItems_ :: Chat 'CTGroup -> Int -> ExceptT StoreError IO (Chat 'CTGroup, Maybe ChatGap)
|
||||
getLatestItems_ c@Chat {chatItems} gapToLatest = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
latestItemIds <- liftIO $ getGroupChatItemIdsLast_ db user g (min count gapToLatest) ""
|
||||
latestItems <- liftIO $ mapM (safeGetGroupItem db user g currentTs) latestItemIds
|
||||
let allItems = chatItems <> latestItems
|
||||
let chat = c {chatItems = allItems}
|
||||
if gapToLatest > length latestItems
|
||||
then pure (chat, Just $ gapToLatest - length latestItems)
|
||||
else pure (chat, Nothing)
|
||||
|
||||
getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal, Maybe ChatGap)
|
||||
getLocalChat db user folderId pagination search_ = do
|
||||
let search = fromMaybe "" search_
|
||||
nf <- getNoteFolder db user folderId
|
||||
case pagination of
|
||||
CPLast count -> liftIO $ getLocalChatLast_ db user nf count search
|
||||
CPLast count -> liftIO $ (,Nothing) <$> 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
|
||||
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_
|
||||
chatItemIds <- getLocalChatItemIdsLast_ db user nf count search
|
||||
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)
|
||||
|
||||
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)
|
||||
|
||||
getLocalChatItemGapToLatest_ :: DB.Connection -> User -> NoteFolder -> CChatItem 'CTLocal -> String -> IO Int
|
||||
getLocalChatItemGapToLatest_ db User {userId} NoteFolder {noteFolderId} chatItem search = do
|
||||
count <-
|
||||
maybeFirstRow fromOnly $
|
||||
DB.queryNamed
|
||||
db
|
||||
[sql|
|
||||
SELECT COUNT(1)
|
||||
FROM chat_items
|
||||
WHERE user_id = :userId AND note_folder_id = :noteFolderId AND item_text LIKE '%' || :search || '%'
|
||||
AND (created_at > :itemCreatedAt OR (created_at = :itemCreatedAt AND chat_item_id > :chatItemId))
|
||||
|]
|
||||
[ ":userId" := userId,
|
||||
":noteFolderId" := noteFolderId,
|
||||
":search" := search,
|
||||
":itemCreatedAt" := chatItemCreatedAt chatItem,
|
||||
":chatItemId" := cchatItemId chatItem
|
||||
]
|
||||
pure $ maybe 0 (\c -> max 0 (c - 1)) count
|
||||
|
||||
safeGetLocalItem :: DB.Connection -> User -> NoteFolder -> UTCTime -> ChatItemId -> IO (CChatItem 'CTLocal)
|
||||
safeGetLocalItem db user NoteFolder {noteFolderId} currentTs itemId =
|
||||
@@ -1276,14 +1425,16 @@ safeToLocalItem currentTs itemId = \case
|
||||
file = Nothing
|
||||
}
|
||||
|
||||
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal, Maybe ChatGap)
|
||||
getLocalChatAfter_ db user nf@NoteFolder {noteFolderId} afterChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
afterChatItem <- getLocalChatItem db user noteFolderId afterChatItemId
|
||||
chatItemIds <- liftIO $ getLocalChatItemIdsAfter_ db user nf afterChatItemId count search (chatItemCreatedAt afterChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetLocalItem db user nf currentTs) chatItemIds
|
||||
pure $ Chat (LocalChat nf) chatItems stats
|
||||
gapToLatest <- liftIO $ getLocalChatItemGapToLatest_ db user nf (head chatItems) search
|
||||
let chatGap = if gapToLatest > 0 then Just gapToLatest else Nothing
|
||||
pure (Chat (LocalChat nf) chatItems stats, chatGap)
|
||||
|
||||
getLocalChatItemIdsAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getLocalChatItemIdsAfter_ db User {userId} NoteFolder {noteFolderId} afterChatItemId count search afterChatItemCreatedAt =
|
||||
@@ -1300,14 +1451,14 @@ getLocalChatItemIdsAfter_ db User {userId} NoteFolder {noteFolderId} afterChatIt
|
||||
|]
|
||||
(userId, noteFolderId, search, afterChatItemCreatedAt, afterChatItemCreatedAt, afterChatItemId, count)
|
||||
|
||||
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal, Maybe ChatGap)
|
||||
getLocalChatBefore_ db user nf@NoteFolder {noteFolderId} beforeChatItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
beforeChatItem <- getLocalChatItem db user noteFolderId beforeChatItemId
|
||||
chatItemIds <- liftIO $ getLocalChatItemIdsBefore_ db user nf beforeChatItemId count search (chatItemCreatedAt beforeChatItem)
|
||||
currentTs <- liftIO getCurrentTime
|
||||
chatItems <- liftIO $ mapM (safeGetLocalItem db user nf currentTs) chatItemIds
|
||||
pure $ Chat (LocalChat nf) (reverse chatItems) stats
|
||||
pure (Chat (LocalChat nf) (reverse chatItems) stats, Nothing)
|
||||
|
||||
getLocalChatItemIdsBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> UTCTime -> IO [ChatItemId]
|
||||
getLocalChatItemIdsBefore_ db User {userId} NoteFolder {noteFolderId} beforeChatItemId count search beforeChatItemCreatedAt =
|
||||
@@ -1324,7 +1475,7 @@ getLocalChatItemIdsBefore_ db User {userId} NoteFolder {noteFolderId} beforeChat
|
||||
|]
|
||||
(userId, noteFolderId, search, beforeChatItemCreatedAt, beforeChatItemCreatedAt, beforeChatItemId, count)
|
||||
|
||||
getLocalChatAround_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal)
|
||||
getLocalChatAround_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal, Maybe ChatGap)
|
||||
getLocalChatAround_ db user nf@NoteFolder {noteFolderId} aroundItemId count search = do
|
||||
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
|
||||
let (fetchCountBefore, fetchCountAfter) = divideFetchCountAround_ (count - 1)
|
||||
@@ -1335,7 +1486,45 @@ getLocalChatAround_ db user nf@NoteFolder {noteFolderId} aroundItemId count sear
|
||||
beforeChatItems <- liftIO $ reverse <$> mapM (safeGetLocalItem db user nf currentTs) beforeIds
|
||||
afterChatItems <- liftIO $ mapM (safeGetLocalItem db user nf currentTs) afterIds
|
||||
let chatItems = beforeChatItems <> [middleChatItem] <> afterChatItems
|
||||
pure $ Chat (LocalChat nf) chatItems stats
|
||||
gapToLatest <- liftIO $ getLocalChatItemGapToLatest_ db user nf (head chatItems) search
|
||||
let chatGap = if gapToLatest > 0 then Just gapToLatest else Nothing
|
||||
pure (Chat (LocalChat nf) chatItems stats, chatGap)
|
||||
|
||||
getLocalChatInitial_ :: DB.Connection -> User -> NoteFolder -> Int -> ExceptT StoreError IO (Chat 'CTLocal, Maybe ChatGap)
|
||||
getLocalChatInitial_ db user@User {userId} nf@NoteFolder {noteFolderId} count = do
|
||||
firstUnreadItemId_ <- liftIO getLocalChatMinUnreadItemId_
|
||||
case firstUnreadItemId_ of
|
||||
Just firstUnreadItemId -> do
|
||||
(chat, gap) <- getLocalChatAround_ db user nf firstUnreadItemId count ""
|
||||
case gap of
|
||||
Just size -> do
|
||||
if size > snd (divideFetchCountAround_ count)
|
||||
then getLatestItems_ chat size
|
||||
else pure (chat, Nothing)
|
||||
Nothing -> pure (chat, Nothing)
|
||||
Nothing -> liftIO $ (,Nothing) <$> getLocalChatLast_ db user nf count ""
|
||||
where
|
||||
getLocalChatMinUnreadItemId_ :: IO (Maybe ChatItemId)
|
||||
getLocalChatMinUnreadItemId_ =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT MIN(chat_item_id)
|
||||
FROM chat_items
|
||||
WHERE user_id = ? AND note_folder_id = ? AND item_status = ?
|
||||
|]
|
||||
(userId, noteFolderId, CISRcvNew)
|
||||
getLatestItems_ :: Chat 'CTLocal -> Int -> ExceptT StoreError IO (Chat 'CTLocal, Maybe ChatGap)
|
||||
getLatestItems_ c@Chat {chatItems} gapToLatest = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
latestItemIds <- liftIO $ getLocalChatItemIdsLast_ db user nf (min count gapToLatest) ""
|
||||
latestItems <- liftIO $ mapM (safeGetLocalItem db user nf currentTs) latestItemIds
|
||||
let allItems = chatItems <> latestItems
|
||||
let chat = c {chatItems = allItems}
|
||||
if gapToLatest > length latestItems
|
||||
then pure (chat, Just $ gapToLatest - length latestItems)
|
||||
else pure (chat, Nothing)
|
||||
|
||||
toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId)
|
||||
toChatItemRef = \case
|
||||
@@ -1628,6 +1817,12 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
|
||||
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"
|
||||
firstUnreadItemId <- liftIO getFirstUnreadItemId_
|
||||
case firstUnreadItemId of
|
||||
Just itemId -> liftIO . getAllChatItemsAround_ itemId count . aChatItemTs =<< getAChatItem_ itemId
|
||||
Nothing -> liftIO $ getAllChatItemsLast_ count
|
||||
mapM (uncurry (getAChatItem db vr user)) itemRefs
|
||||
where
|
||||
search = fromMaybe "" search_
|
||||
@@ -1686,6 +1881,16 @@ getAllChatItems db vr user@User {userId} pagination search_ = do
|
||||
item <- getChatItem aroundId
|
||||
itemsAfter <- getAllChatItemsAfter_ aroundId fetchCountAfter 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 =
|
||||
|
||||
@@ -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 gap -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat] <> viewChatGap gap
|
||||
CRApiParsedMarkdown ft -> [viewJSON ft]
|
||||
CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView
|
||||
CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure
|
||||
@@ -555,6 +555,12 @@ viewUsersList us =
|
||||
viewGroupSubscribed :: GroupInfo -> [StyledString]
|
||||
viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"]
|
||||
|
||||
viewChatGap :: Maybe ChatGap -> [StyledString]
|
||||
viewChatGap Nothing = []
|
||||
viewChatGap (Just size)
|
||||
| size < 1 = []
|
||||
| otherwise = [sShow size <> " newer message(s) available"]
|
||||
|
||||
showSMPServer :: SMPServer -> String
|
||||
showSMPServer ProtocolServer {host} = B.unpack $ strEncode host
|
||||
|
||||
|
||||
Reference in New Issue
Block a user