diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index ba03642a28..b1d80092dc 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -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) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 8a01760d96..44938a9eb3 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index d1792abea3..dea8c10d41 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -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 diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 8f35e3dff0..d296715b4e 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -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 = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index ade36476c7..4c366b7743 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -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