api for chat pagination (#249)

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
+  APIGetChat cType cId pagination -> case cType of
-    CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st userId cId)
+    CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st user cId pagination)
-    CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId)
+    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 /= '@'

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

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

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 :: StoreMonad m => SQLiteStore -> User -> Int64 -> ChatPagination -> m (Chat 'CTDirect)
-getDirectChat st userId contactId =
+getDirectChat st user contactId pagination =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
-    contact <- ExceptT $ getContact_ db userId contactId
+    case pagination of
-    chatItems <- liftIO $ getDirectChatItems_ db userId contactId
+      CPLast count -> getDirectChatLast_ db user contactId count
-    pure $ Chat (DirectChat contact) chatItems
+      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]
+getGroupChat :: StoreMonad m => SQLiteStore -> User -> Int64 -> ChatPagination -> m (Chat 'CTGroup)
-getDirectChatItems_ db userId contactId = do
+getGroupChat st user groupId pagination =
-  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 =
   liftIOEither . withTransaction st $ \db -> runExceptT $ do
-    groupInfo <- ExceptT $ getGroupInfo_ db user groupId
+    case pagination of
-    chatItems <- ExceptT $ getGroupChatItems_ db user groupId
+      CPLast count -> getGroupChatLast_ db user groupId count
-    pure $ Chat (GroupChat groupInfo) chatItems
+      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