diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index c1012f2a0a..2c18d4df27 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -630,7 +630,7 @@ directoryService st DirectoryOpts {adminUsers, superUsers, serviceName, searchRe listGroups count pending = readTVarIO (groupRegs st) >>= \groups -> do grs <- - if pending + if pending then filterM (fmap pendingApproval . readTVarIO . groupRegStatus) groups else pure groups sendReply $ tshow (length grs) <> " registered group(s)" <> (if length grs > count then ", showing the last " <> tshow count else "") @@ -689,7 +689,7 @@ getContact cc ctId = resp <$> sendChatCmd cc (APIGetChat (ChatRef CTDirect ctId) where resp :: ChatResponse -> Maybe Contact resp = \case - CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) -> Just ct + CRApiChat _ (AChat SCTDirect Chat {chatInfo = DirectChat ct}) _ -> Just ct _ -> Nothing getGroup :: ChatController -> GroupId -> IO (Maybe GroupInfo) diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 96d16f5004..fb7f32faa5 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -150,6 +150,7 @@ library Simplex.Chat.Migrations.M20240920_user_order Simplex.Chat.Migrations.M20241008_indexes Simplex.Chat.Migrations.M20241010_contact_requests_contact_id + Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 885d4303c8..b74531b9e1 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, navInfo) <- withFastStore (\db -> getDirectChat db vr user cId pagination search) + pure $ CRApiChat user (AChat SCTDirect directChat) navInfo CTGroup -> do - groupChat <- withFastStore (\db -> getGroupChat db vr user cId pagination search) - pure $ CRApiChat user (AChat SCTGroup groupChat) + (groupChat, navInfo) <- withFastStore (\db -> getGroupChat db vr user cId pagination search) + pure $ CRApiChat user (AChat SCTGroup groupChat) navInfo CTLocal -> do - localChat <- withFastStore (\db -> getLocalChat db user cId pagination search) - pure $ CRApiChat user (AChat SCTLocal localChat) + (localChat, navInfo) <- withFastStore (\db -> getLocalChat db user cId pagination search) + pure $ CRApiChat user (AChat SCTLocal localChat) navInfo CTContactRequest -> pure $ chatCmdError (Just user) "not implemented" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIGetChatItems pagination search -> withUser $ \user -> do @@ -8301,6 +8301,8 @@ chatCommandP = (CPLast <$ "count=" <*> A.decimal) <|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) <|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) + <|> (CPAround <$ "around=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) + <|> (CPInitial <$ "initial=" <*> A.decimal) paginationByTimeP = (PTLast <$ "count=" <*> A.decimal) <|> (PTAfter <$ "after=" <*> strP <* A.space <* "count=" <*> A.decimal) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index b39b4d7456..4be6086acb 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, navInfo :: Maybe NavigationInfo} | CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]} | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo} | CRChatItemId User (Maybe ChatItemId) @@ -839,6 +839,8 @@ data ChatPagination = CPLast Int | CPAfter ChatItemId Int | CPBefore ChatItemId Int + | CPAround ChatItemId Int + | CPInitial Int deriving (Show) data PaginationByTime diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 50e68e5bf4..0e3575b64c 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -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) diff --git a/src/Simplex/Chat/Migrations/M20241023_chat_item_autoincrement_id.hs b/src/Simplex/Chat/Migrations/M20241023_chat_item_autoincrement_id.hs new file mode 100644 index 0000000000..7f1e272026 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20241023_chat_item_autoincrement_id.hs @@ -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; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 2619a5c4e5..f16ca6b870 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -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, diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index ad77e6c3f1..ab8a52a98a 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -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_ = diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index e2d12e78d7..2444078a33 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -114,6 +114,7 @@ import Simplex.Chat.Migrations.M20240827_calls_uuid import Simplex.Chat.Migrations.M20240920_user_order import Simplex.Chat.Migrations.M20241008_indexes import Simplex.Chat.Migrations.M20241010_contact_requests_contact_id +import Simplex.Chat.Migrations.M20241023_chat_item_autoincrement_id import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -227,7 +228,8 @@ schemaMigrations = ("20240827_calls_uuid", m20240827_calls_uuid, Just down_m20240827_calls_uuid), ("20240920_user_order", m20240920_user_order, Just down_m20240920_user_order), ("20241008_indexes", m20241008_indexes, Just down_m20241008_indexes), - ("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id) + ("20241010_contact_requests_contact_id", m20241010_contact_requests_contact_id, Just down_m20241010_contact_requests_contact_id), + ("20241023_chat_item_autoincrement_id", m20241023_chat_item_autoincrement_id, Just down_m20241023_chat_item_autoincrement_id) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index ade36476c7..8ae74e8961 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 _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat] CRApiParsedMarkdown ft -> [viewJSON ft] CRUserProtoServers u userServers -> ttyUser u $ viewUserServers userServers testView CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 8971e8d22d..8756657e59 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -66,6 +66,7 @@ chatDirectTests = do it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact it "should send multiline message" testMultilineMessage it "send large message" testLargeMessage + it "initial chat pagination" testChatPaginationInitial describe "batch send messages" $ do it "send multiple messages api" testSendMulti it "send multiple timed messages" testSendMultiTimed @@ -123,7 +124,7 @@ chatDirectTests = do it "chat items only expire for users who configured expiration" testEnableCIExpirationOnlyForOneUser it "disabling chat item expiration doesn't disable it for other users" testDisableCIExpirationOnlyForOneUser it "both users have configured timed messages with contacts, messages expire, restart" testUsersTimedMessages - it "user profile privacy: hide profiles and notificaitons" testUserPrivacy + it "user profile privacy: hide profiles and notifications" testUserPrivacy describe "settings" $ do it "set chat item expiration TTL" testSetChatItemTTL it "save/get app settings" testAppSettings @@ -210,6 +211,7 @@ testAddContact = versionTestMatrix2 runTestAddContact -- pagination alice #$> ("/_get chat @2 after=" <> itemId 1 <> " count=100", chat, [(0, "hello there"), (0, "how are you?")]) alice #$> ("/_get chat @2 before=" <> itemId 2 <> " count=100", chat, features <> [(1, "hello there 🙂")]) + alice #$> ("/_get chat @2 around=" <> itemId 2 <> " count=2", chat, [(0, "Audio/video calls: enabled"), (1, "hello there 🙂"), (0, "hello there"), (0, "how are you?")]) -- search alice #$> ("/_get chat @2 count=100 search=ello ther", chat, [(1, "hello there 🙂"), (0, "hello there")]) -- read messages @@ -360,6 +362,36 @@ testMarkReadDirect = testChat2 aliceProfile bobProfile $ \alice bob -> do let itemIds = intercalate "," $ map show [i - 3 .. i] bob #$> ("/_read chat items @2 " <> itemIds, id, "ok") +testChatPaginationInitial :: HasCallStack => FilePath -> IO () +testChatPaginationInitial = testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> do + connectUsers alice bob + -- Wait, otherwise ids are going to be wrong. + threadDelay 1000000 + + -- Send messages from alice to bob + forM_ ([1 .. 10] :: [Int]) $ \n -> alice #> ("@bob " <> show n) + + -- Bob receives the messages. + forM_ ([1 .. 10] :: [Int]) $ \n -> bob <# ("alice> " <> show n) + + -- All messages are unread for bob, should return area around unread + bob #$> ("/_get chat @2 initial=2", chat, [(0, "Voice messages: enabled"), (0, "Audio/video calls: enabled"), (0, "1"), (0, "2"), (0, "3")]) + + -- Read next 2 items + let itemIds = intercalate "," $ map itemId [1 .. 2] + bob #$> ("/_read chat items @2 " <> itemIds, id, "ok") + bob #$> ("/_get chat @2 initial=2", chat, [(0, "1"), (0, "2"), (0, "3"), (0, "4"), (0, "5")]) + + -- Read all items + bob #$> ("/_read chat @2", id, "ok") + bob #$> ("/_get chat @2 initial=3", chat, [(0, "8"), (0, "9"), (0, "10")]) + bob #$> ("/_get chat @2 initial=5", chat, [(0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")]) + where + opts = + testOpts + { markRead = False + } + testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO () testDuplicateContactsSeparate = testChat2 aliceProfile bobProfile $ @@ -791,7 +823,7 @@ testDirectMessageDelete = alice @@@ [("@bob", lastChatFeature)] alice #$> ("/_get chat @2 count=100", chat, chatFeatures) - -- alice: msg id 1 + -- alice: msg id 3 bob ##> ("/_update item @2 " <> itemId 2 <> " text hey alice") bob <# "@alice [edited] > hello 🙂" bob <## " hey alice" @@ -806,12 +838,12 @@ testDirectMessageDelete = alice @@@ [("@bob", "hey alice [marked deleted]")] alice #$> ("/_get chat @2 count=100", chat, chatFeatures <> [(0, "hey alice [marked deleted]")]) - -- alice: deletes msg id 1 that was broadcast deleted by bob - alice #$> ("/_delete item @2 " <> itemId 1 <> " internal", id, "message deleted") + -- alice: deletes msg id 3 that was broadcast deleted by bob + alice #$> ("/_delete item @2 " <> itemId 3 <> " internal", id, "message deleted") alice @@@ [("@bob", lastChatFeature)] alice #$> ("/_get chat @2 count=100", chat, chatFeatures) - -- alice: msg id 1, bob: msg id 3 (quoting message alice deleted locally) + -- alice: msg id 4, bob: msg id 3 (quoting message alice deleted locally) bob `send` "> @alice (hello 🙂) do you receive my messages?" bob <# "@alice > hello 🙂" bob <## " do you receive my messages?" @@ -819,14 +851,14 @@ testDirectMessageDelete = alice <## " do you receive my messages?" alice @@@ [("@bob", "do you receive my messages?")] alice #$> ("/_get chat @2 count=100", chat', chatFeatures' <> [((0, "do you receive my messages?"), Just (1, "hello 🙂"))]) - alice #$> ("/_delete item @2 " <> itemId 1 <> " broadcast", id, "cannot delete this item") + alice #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "cannot delete this item") - -- alice: msg id 2, bob: msg id 4 + -- alice: msg id 5, bob: msg id 4 bob #> "@alice how are you?" alice <# "bob> how are you?" - -- alice: deletes msg id 2 - alice #$> ("/_delete item @2 " <> itemId 2 <> " internal", id, "message deleted") + -- alice: deletes msg id 5 + alice #$> ("/_delete item @2 " <> itemId 5 <> " internal", id, "message deleted") -- bob: marks deleted msg id 4 (that alice deleted locally) bob #$> ("/_delete item @2 " <> itemId 4 <> " broadcast", id, "message marked deleted") @@ -2340,6 +2372,14 @@ testUserPrivacy = "bob> Voice messages: enabled", "bob> Audio/video calls: enabled" ] + alice ##> "/_get items around=11 count=2" + alice + <##? [ "bob> Full deletion: off", + "bob> Message reactions: enabled", + "bob> Voice messages: enabled", + "bob> Audio/video calls: enabled", + "@bob hello" + ] alice ##> "/_get items after=12 count=10" alice <##? [ "@bob hello", diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index f1a36c8722..a7de42128c 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -36,6 +36,7 @@ chatGroupTests = do describe "chat groups" $ do describe "add contacts, create group and send/receive messages" testGroupMatrix it "mark multiple messages as read" testMarkReadGroup + it "initial chat pagination" testChatPaginationInitial it "v1: add contacts, create group and send/receive messages" testGroup it "v1: add contacts, create group and send/receive messages, check messages" testGroupCheckMessages it "send large message" testGroupLargeMessage @@ -344,6 +345,7 @@ testGroupShared alice bob cath checkMessages directConnections = do -- so we take into account group event items as well as sent group invitations in direct chats alice #$> ("/_get chat #1 after=" <> msgItem1 <> " count=100", chat, [(0, "hi there"), (0, "hey team")]) alice #$> ("/_get chat #1 before=" <> msgItem2 <> " count=100", chat, [(1, e2eeInfoNoPQStr), (0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")]) + alice #$> ("/_get chat #1 around=" <> msgItem1 <> " count=2", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")]) alice #$> ("/_get chat #1 count=100 search=team", chat, [(0, "hey team")]) bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")]) @@ -374,6 +376,38 @@ testMarkReadGroup = testChat2 aliceProfile bobProfile $ \alice bob -> do let itemIds = intercalate "," $ map show [i - 3 .. i] bob #$> ("/_read chat items #1 " <> itemIds, id, "ok") +testChatPaginationInitial :: HasCallStack => FilePath -> IO () +testChatPaginationInitial = testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> do + createGroup2 "team" alice bob + -- Wait, otherwise ids are going to be wrong. + threadDelay 1000000 + lastEventId <- (read :: String -> Int) <$> lastItemId bob + let groupItemId n = show $ lastEventId + n + + -- Send messages from alice to bob + forM_ ([1 .. 10] :: [Int]) $ \n -> alice #> ("#team " <> show n) + + -- Bob receives the messages. + forM_ ([1 .. 10] :: [Int]) $ \n -> bob <# ("#team alice> " <> show n) + + -- All messages are unread for bob, should return area around unread + bob #$> ("/_get chat #1 initial=2", chat, [(0, "Recent history: on"), (0, "connected"), (0, "1"), (0, "2"), (0, "3")]) + + -- Read next 2 items + let itemIds = intercalate "," $ map groupItemId [1 .. 2] + bob #$> ("/_read chat items #1 " <> itemIds, id, "ok") + bob #$> ("/_get chat #1 initial=2", chat, [(0, "1"), (0, "2"), (0, "3"), (0, "4"), (0, "5")]) + + -- Read all items + bob #$> ("/_read chat #1", id, "ok") + bob #$> ("/_get chat #1 initial=3", chat, [(0, "8"), (0, "9"), (0, "10")]) + bob #$> ("/_get chat #1 initial=5", chat, [(0, "6"), (0, "7"), (0, "8"), (0, "9"), (0, "10")]) + where + opts = + testOpts + { markRead = False + } + testGroupLargeMessage :: HasCallStack => FilePath -> IO () testGroupLargeMessage = testChat2 aliceProfile bobProfile $ diff --git a/tests/ChatTests/Local.hs b/tests/ChatTests/Local.hs index da9c043648..40df02252d 100644 --- a/tests/ChatTests/Local.hs +++ b/tests/ChatTests/Local.hs @@ -51,7 +51,7 @@ testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do alice ##> "/chats" alice /* "ahoy!" - alice ##> "/_update item *1 1 text Greetings." + alice ##> "/_update item *1 2 text Greetings." alice ##> "/tail *" alice <# "* Greetings." @@ -102,6 +102,10 @@ testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do alice #$> ("/_get chat *1 count=100", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")]) alice #$> ("/_get chat *1 count=1", chat, [(1, "who's there?")]) + alice #$> ("/_get chat *1 around=2 count=1", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock")]) + alice #$> ("/_get chat *1 around=2 count=3", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")]) + alice #$> ("/_get chat *1 around=3 count=10", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")]) + alice #$> ("/_get chat *1 around=4 count=1", chat, [(1, "knock-knock"), (1, "who's there?")]) alice #$> ("/_get chat *1 after=2 count=10", chat, [(1, "knock-knock"), (1, "who's there?")]) alice #$> ("/_get chat *1 after=2 count=2", chat, [(1, "knock-knock"), (1, "who's there?")]) alice #$> ("/_get chat *1 after=1 count=2", chat, [(1, "memento mori"), (1, "knock-knock")]) diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index 23f36713b4..4e63a31001 100644 --- a/tests/SchemaDump.hs +++ b/tests/SchemaDump.hs @@ -102,7 +102,9 @@ skipComparisonForDownMigrations = -- table and indexes move down to the end of the file "20231215_recreate_msg_deliveries", -- on down migration idx_msg_deliveries_agent_ack_cmd_id index moves down to the end of the file - "20240313_drop_agent_ack_cmd_id" + "20240313_drop_agent_ack_cmd_id", + -- on down migration chat_item_autoincrement_id makes sequence table creation move down on the file + "20241023_chat_item_autoincrement_id" ] getSchema :: FilePath -> FilePath -> IO String