From 228c118714e95ff3d2d91b8b906d1b8aca15ca2c Mon Sep 17 00:00:00 2001 From: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com> Date: Tue, 1 Feb 2022 15:05:27 +0400 Subject: [PATCH] api for chat pagination (#249) --- src/Simplex/Chat.hs | 12 +- src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Messages.hs | 6 + src/Simplex/Chat/Store.hs | 213 +++++++++++++++++++++++++-------- 4 files changed, 181 insertions(+), 52 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 5806f20b9..ebbe5c450 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -125,9 +125,9 @@ toView event = do processChatCommand :: forall m. ChatMonad m => User -> ChatCommand -> m ChatResponse processChatCommand user@User {userId, profile} = \case APIGetChats -> CRApiChats <$> withStore (`getChatPreviews` user) - APIGetChat cType cId -> case cType of - CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st userId cId) - CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId) + APIGetChat cType cId pagination -> case cType of + CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st user cId pagination) + CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId pagination) CTContactRequest -> pure $ CRChatError ChatErrorNotImplemented APIGetChatItems _count -> pure $ CRChatError ChatErrorNotImplemented APISendMessage cType chatId mc -> case cType of @@ -1320,7 +1320,7 @@ withStore action = chatCommandP :: Parser ChatCommand chatCommandP = "/_get chats" $> APIGetChats - <|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal) + <|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP) <|> "/_get items count=" *> (APIGetChatItems <$> A.decimal) <|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <* A.space <*> msgContentP) <|> "/_delete " *> (APIDeleteChat <$> chatTypeP <*> A.decimal) @@ -1363,6 +1363,10 @@ chatCommandP = <|> ("/version" <|> "/v") $> ShowVersion where chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup + chatPaginationP = + (CPLast <$ "count=" <*> A.decimal) + <|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) + <|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) msgContentP = "text " *> (MCText . safeDecodeUtf8 <$> A.takeByteString) displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' ')) refChar c = c > ' ' && c /= '#' && c /= '@' diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 55fc3eeb1..02ffae68b 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -79,7 +79,7 @@ instance ToJSON HelpSection where data ChatCommand = APIGetChats - | APIGetChat ChatType Int64 + | APIGetChat ChatType Int64 ChatPagination | APIGetChatItems Int | APISendMessage ChatType Int64 MsgContent | APIDeleteChat ChatType Int64 diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 1b31d8c4d..166ceb340 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -191,6 +191,12 @@ instance ToJSON CIMeta where toEncoding = J.genericToEncoding J.defaultOptions type ChatItemId = Int64 +data ChatPagination + = CPLast Int + | CPAfter ChatItemId Int + | CPBefore ChatItemId Int + deriving (Show) + type ChatItemTs = UTCTime data CIContent (d :: MsgDirection) where diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index f55fdb122..5ec2f3db3 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -1842,7 +1842,10 @@ getChatPreviews st user = where ts :: AChat -> UTCTime ts (AChat _ (Chat _ [])) = UTCTime (fromGregorian 2122 1 29) (secondsToDiffTime 0) -- TODO Contact/GroupInfo/ContactRequest createdAt - ts (AChat _ (Chat _ (CChatItem _ (ChatItem _ CIMeta {itemTs} _) : _))) = itemTs + ts (AChat _ (Chat _ (ci : _))) = chatItemTs ci + +chatItemTs :: CChatItem d -> UTCTime +chatItemTs (CChatItem _ (ChatItem _ CIMeta {itemTs} _)) = itemTs getDirectChatPreviews_ :: DB.Connection -> User -> IO [AChat] getDirectChatPreviews_ db User {userId} = do @@ -1954,12 +1957,76 @@ getContactRequestChatPreviews_ db User {userId} = let cReq = toContactRequest cReqRow in AChat SCTContactRequest $ Chat (ContactRequest cReq) [] -getDirectChat :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m (Chat 'CTDirect) -getDirectChat st userId contactId = +getDirectChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> ChatPagination -> m (Chat 'CTDirect) +getDirectChat st user contactId pagination = liftIOEither . withTransaction st $ \db -> runExceptT $ do - contact <- ExceptT $ getContact_ db userId contactId - chatItems <- liftIO $ getDirectChatItems_ db userId contactId - pure $ Chat (DirectChat contact) chatItems + case pagination of + CPLast count -> getDirectChatLast_ db user contactId count + CPAfter afterId count -> getDirectChatAfter_ db user contactId afterId count + CPBefore beforeId count -> getDirectChatBefore_ db user contactId beforeId count + +getDirectChatLast_ :: DB.Connection -> User -> Int64 -> Int -> ExceptT StoreError IO (Chat 'CTDirect) +getDirectChatLast_ db User {userId} contactId count = do + contact <- ExceptT $ getContact_ db userId contactId + chatItems <- liftIO getDirectChatItemsLast_ + pure $ Chat (DirectChat contact) (sortOn chatItemTs chatItems) + where + getDirectChatItemsLast_ :: IO [CChatItem 'CTDirect] + getDirectChatItemsLast_ = do + tz <- getCurrentTimeZone + map (toDirectChatItem tz) + <$> DB.query + db + [sql| + SELECT chat_item_id, item_ts, item_content, item_text, created_at + FROM chat_items + WHERE user_id = ? AND contact_id = ? + ORDER BY item_ts DESC + LIMIT ? + |] + (userId, contactId, count) + +getDirectChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTDirect) +getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do + contact <- ExceptT $ getContact_ db userId contactId + chatItems <- liftIO getDirectChatItemsAfter_ + pure $ Chat (DirectChat contact) chatItems + where + getDirectChatItemsAfter_ :: IO [CChatItem 'CTDirect] + getDirectChatItemsAfter_ = do + tz <- getCurrentTimeZone + map (toDirectChatItem tz) + <$> DB.query + db + [sql| + SELECT chat_item_id, item_ts, item_content, item_text, created_at + FROM chat_items + WHERE user_id = ? AND contact_id = ? AND chat_item_id > ? + ORDER BY item_ts ASC + LIMIT ? + |] + (userId, contactId, afterChatItemId, count) + +getDirectChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTDirect) +getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do + contact <- ExceptT $ getContact_ db userId contactId + chatItems <- liftIO getDirectChatItemsBefore_ + pure $ Chat (DirectChat contact) (sortOn chatItemTs chatItems) + where + getDirectChatItemsBefore_ :: IO [CChatItem 'CTDirect] + getDirectChatItemsBefore_ = do + tz <- getCurrentTimeZone + map (toDirectChatItem tz) + <$> DB.query + db + [sql| + SELECT chat_item_id, item_ts, item_content, item_text, created_at + FROM chat_items + WHERE user_id = ? AND contact_id = ? AND chat_item_id < ? + ORDER BY item_ts DESC + LIMIT ? + |] + (userId, contactId, beforeChatItemId, count) getContactIdByName :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m Int64 getContactIdByName st userId cName = @@ -2001,26 +2068,100 @@ getContact_ db userId contactId = (userId, contactId, ConnReady, ConnSndReady) ) -getDirectChatItems_ :: DB.Connection -> UserId -> Int64 -> IO [CChatItem 'CTDirect] -getDirectChatItems_ db userId contactId = do - tz <- getCurrentTimeZone - map (toDirectChatItem tz) - <$> DB.query - db - [sql| - SELECT chat_item_id, item_ts, item_content, item_text, created_at - FROM chat_items - WHERE user_id = ? AND contact_id = ? - ORDER BY item_ts ASC - |] - (userId, contactId) - -getGroupChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> m (Chat 'CTGroup) -getGroupChat st user groupId = +getGroupChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> ChatPagination -> m (Chat 'CTGroup) +getGroupChat st user groupId pagination = liftIOEither . withTransaction st $ \db -> runExceptT $ do - groupInfo <- ExceptT $ getGroupInfo_ db user groupId - chatItems <- ExceptT $ getGroupChatItems_ db user groupId - pure $ Chat (GroupChat groupInfo) chatItems + case pagination of + CPLast count -> getGroupChatLast_ db user groupId count + CPAfter afterId count -> getGroupChatAfter_ db user groupId afterId count + CPBefore beforeId count -> getGroupChatBefore_ db user groupId beforeId count + +getGroupChatLast_ :: DB.Connection -> User -> Int64 -> Int -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChatLast_ db user@User {userId, userContactId} groupId count = do + groupInfo <- ExceptT $ getGroupInfo_ db user groupId + chatItems <- ExceptT getGroupChatItemsLast_ + pure $ Chat (GroupChat groupInfo) (sortOn chatItemTs chatItems) + where + getGroupChatItemsLast_ :: IO (Either StoreError [CChatItem 'CTGroup]) + getGroupChatItemsLast_ = do + tz <- getCurrentTimeZone + mapM (toGroupChatItem tz userContactId) + <$> DB.query + db + [sql| + SELECT + -- ChatItem + ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at, + -- GroupMember + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, + m.member_status, m.invited_by, m.local_display_name, m.contact_id, + p.display_name, p.full_name + FROM chat_items ci + LEFT JOIN group_members m ON m.group_member_id = ci.group_member_id + LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id + WHERE ci.user_id = ? AND ci.group_id = ? + ORDER BY item_ts DESC + LIMIT ? + |] + (userId, groupId, count) + +getGroupChatAfter_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChatAfter_ db user@User {userId, userContactId} groupId afterChatItemId count = do + groupInfo <- ExceptT $ getGroupInfo_ db user groupId + chatItems <- ExceptT getGroupChatItemsAfter_ + pure $ Chat (GroupChat groupInfo) chatItems + where + getGroupChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTGroup]) + getGroupChatItemsAfter_ = do + tz <- getCurrentTimeZone + mapM (toGroupChatItem tz userContactId) + <$> DB.query + db + [sql| + SELECT + -- ChatItem + ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at, + -- GroupMember + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, + m.member_status, m.invited_by, m.local_display_name, m.contact_id, + p.display_name, p.full_name + FROM chat_items ci + LEFT JOIN group_members m ON m.group_member_id = ci.group_member_id + LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id + WHERE ci.user_id = ? AND ci.group_id = ? AND ci.chat_item_id > ? + ORDER BY item_ts ASC + LIMIT ? + |] + (userId, groupId, afterChatItemId, count) + +getGroupChatBefore_ :: DB.Connection -> User -> Int64 -> ChatItemId -> Int -> ExceptT StoreError IO (Chat 'CTGroup) +getGroupChatBefore_ db user@User {userId, userContactId} groupId beforeChatItemId count = do + groupInfo <- ExceptT $ getGroupInfo_ db user groupId + chatItems <- ExceptT getGroupChatItemsBefore_ + pure $ Chat (GroupChat groupInfo) (sortOn chatItemTs chatItems) + where + getGroupChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTGroup]) + getGroupChatItemsBefore_ = do + tz <- getCurrentTimeZone + mapM (toGroupChatItem tz userContactId) + <$> DB.query + db + [sql| + SELECT + -- ChatItem + ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at, + -- GroupMember + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, + m.member_status, m.invited_by, m.local_display_name, m.contact_id, + p.display_name, p.full_name + FROM chat_items ci + LEFT JOIN group_members m ON m.group_member_id = ci.group_member_id + LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id + WHERE ci.user_id = ? AND ci.group_id = ? AND ci.chat_item_id < ? + ORDER BY item_ts DESC + LIMIT ? + |] + (userId, groupId, beforeChatItemId, count) getGroupInfo :: StoreMonad m => SQLiteStore -> User -> Int64 -> m GroupInfo getGroupInfo st user groupId = @@ -2048,28 +2189,6 @@ getGroupInfo_ db User {userId, userContactId} groupId = |] (groupId, userId, userContactId) -getGroupChatItems_ :: DB.Connection -> User -> Int64 -> IO (Either StoreError [CChatItem 'CTGroup]) -getGroupChatItems_ db User {userId, userContactId} groupId = do - tz <- getCurrentTimeZone - mapM (toGroupChatItem tz userContactId) - <$> DB.query - db - [sql| - SELECT - -- ChatItem - ci.chat_item_id, ci.item_ts, ci.item_content, ci.item_text, ci.created_at, - -- GroupMember - m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, - m.member_status, m.invited_by, m.local_display_name, m.contact_id, - p.display_name, p.full_name - FROM chat_items ci - LEFT JOIN group_members m ON m.group_member_id = ci.group_member_id - LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id - WHERE ci.user_id = ? AND ci.group_id = ? - ORDER BY ci.item_ts ASC - |] - (userId, groupId) - getGroupIdByName :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Int64 getGroupIdByName st user gName = liftIOEither . withTransaction st $ \db -> getGroupIdByName_ db user gName