Add new API to list paginated qualified conv ids

CHANGELOG.md

@@ -29,10 +29,17 @@
 
 ## API Changes
 
+* Add `POST /conversations/list-ids` (#1686)
+* Deprecate `GET /converstations/ids` (#1686)
+
 ## Features
 
 ## Bug fixes and other updates
 
+## Federation changes (alpha feature, do not use yet)
+
+* Add new API to list paginated qualified conversation ids (#1686)
+
 ## Documentation
 
 *  fix swagger: mark name in UserUpdate as optional (#1691)

libs/wire-api/src/Wire/API/Conversation.hs

@@ -26,6 +26,7 @@ module Wire.API.Conversation
     ConversationCoverView (..),
     ConversationList (..),
     ListConversations (..),
+    GetPaginatedConversationIds (..),
 
     -- * Conversation properties
     Access (..),
@@ -79,7 +80,7 @@ import Data.List1
 import Data.Misc
 import Data.Proxy (Proxy (Proxy))
 import Data.Qualified (Qualified (qUnqualified), deprecatedSchema)
-import Data.Range (Range)
+import Data.Range (Range, toRange)
 import Data.Schema
 import qualified Data.Set as Set
 import Data.String.Conversions (cs)
@@ -225,6 +226,9 @@ instance ConversationListItem ConvId where
 instance ConversationListItem Conversation where
   convListItemName _ = "conversations"
 
+instance ConversationListItem (Qualified ConvId) where
+  convListItemName _ = "qualified Conversation IDs"
+
 instance (ConversationListItem a, S.ToSchema a) => S.ToSchema (ConversationList a) where
   declareNamedSchema _ = do
     listSchema <- S.declareSchemaRef (Proxy @[a])
@@ -252,6 +256,27 @@ instance FromJSON a => FromJSON (ConversationList a) where
       <$> o A..: "conversations"
       <*> o A..: "has_more"
 
+data GetPaginatedConversationIds = GetPaginatedConversationIds
+  { gpciStartingPoint :: Maybe (Qualified ConvId),
+    gpciSize :: Range 1 1000 Int32
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (FromJSON, ToJSON, S.ToSchema) via Schema GetPaginatedConversationIds
+
+instance ToSchema GetPaginatedConversationIds where
+  schema =
+    let addStartingPointDoc =
+          description
+            ?~ "starting conversation id, this conversation id will not be included in the response. \
+               \The conversations are ordered lexicographically by domain and then by id using UUID ordering."
+        addSizeDoc = description ?~ "optional, must be <= 1000, defaults to 1000."
+     in objectWithDocModifier
+          "GetPaginatedConversationIds"
+          (description ?~ "A request to list some or all of a user's conversation ids, including remote ones")
+          $ GetPaginatedConversationIds
+            <$> gpciStartingPoint .= optFieldWithDocModifier "starting_point" Nothing addStartingPointDoc schema
+            <*> gpciSize .= (fieldWithDocModifier "size" addSizeDoc schema <|> pure (toRange (Proxy @1000)))
+
 -- | Used on the POST /list-conversations endpoint
 -- FUTUREWORK: add to golden tests (how to generate them?)
 data ListConversations = ListConversations

libs/wire-api/src/Wire/API/Routes/Public/Galley.hs

@@ -140,9 +140,9 @@ data Api routes = Api
         :> Capture "cnv" ConvId
         :> "roles"
         :> Get '[Servant.JSON] Public.ConversationRolesList,
-    getConversationIds ::
+    listConversationIdsUnqualified ::
       routes
-        :- Summary "Get all conversation IDs."
+        :- Summary "[deprecated] Get all local conversation IDs."
         -- FUTUREWORK: add bounds to swagger schema for Range
         :> ZUser
         :> "conversations"
@@ -162,6 +162,14 @@ data Api routes = Api
              "size"
              (Range 1 1000 Int32)
         :> Get '[Servant.JSON] (Public.ConversationList ConvId),
+    listConversationIds ::
+      routes
+        :- Summary "Get all conversation IDs."
+          :> ZUser
+          :> "conversations"
+          :> "list-ids"
+          :> ReqBody '[Servant.JSON] Public.GetPaginatedConversationIds
+          :> Post '[Servant.JSON] (Public.ConversationList (Qualified ConvId)),
     getConversations ::
       routes
         :- Summary "Get all *local* conversations."

services/galley/src/Galley/API/Public.hs

@@ -80,7 +80,8 @@ servantSitemap =
       { GalleyAPI.getUnqualifiedConversation = Query.getUnqualifiedConversation,
         GalleyAPI.getConversation = Query.getConversation,
         GalleyAPI.getConversationRoles = Query.getConversationRoles,
-        GalleyAPI.getConversationIds = Query.getConversationIds,
+        GalleyAPI.listConversationIdsUnqualified = Query.listConversationIdsUnqualified,
+        GalleyAPI.listConversationIds = Query.listConversationIds,
         GalleyAPI.getConversations = Query.getConversations,
         GalleyAPI.getConversationByReusableCode = Query.getConversationByReusableCode,
         GalleyAPI.listConversations = Query.listConversations,

services/galley/src/Galley/API/Query.hs

@@ -14,13 +14,15 @@
 --
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
+{-# LANGUAGE RecordWildCards #-}
 
 module Galley.API.Query
   ( getBotConversationH,
     getUnqualifiedConversation,
     getConversation,
     getConversationRoles,
-    getConversationIds,
+    listConversationIdsUnqualified,
+    listConversationIds,
     getConversations,
     listConversations,
     iterateConversations,
@@ -118,15 +120,51 @@ getConversationRoles zusr cnv = do
   --       be merged with the team roles (if they exist)
   pure $ Public.ConversationRolesList wireConvRoles
 
-getConversationIds :: UserId -> Maybe ConvId -> Maybe (Range 1 1000 Int32) -> Galley (Public.ConversationList ConvId)
-getConversationIds zusr start msize = do
+listConversationIdsUnqualified :: UserId -> Maybe ConvId -> Maybe (Range 1 1000 Int32) -> Galley (Public.ConversationList ConvId)
+listConversationIdsUnqualified zusr start msize = do
   let size = fromMaybe (toRange (Proxy @1000)) msize
   ids <- Data.conversationIdsFrom zusr start size
   pure $
     Public.ConversationList
       (Data.resultSetResult ids)
       (Data.resultSetType ids == Data.ResultSetTruncated)
 
+-- | Lists conversation ids for the logged in user. The request can optionally
+-- have a 'startingPoint', this can be used to list conversation ids in a
+-- paginated way.
+--
+-- Pagination requires an order, in this case the order is defined as:
+--
+-- - First all the local conversations are listed ordered by their id
+--
+-- - After local conversations, remote conversations are listed ordered
+-- - lexicographically by their domain and then by their id.
+listConversationIds :: UserId -> Public.GetPaginatedConversationIds -> Galley (Public.ConversationList (Qualified ConvId))
+listConversationIds zusr Public.GetPaginatedConversationIds {..} = do
+  localDomain <- viewFederationDomain
+  let mStartDomain = qDomain <$> gpciStartingPoint
+  case mStartDomain of
+    Nothing -> localsAndRemotes localDomain Nothing gpciSize
+    Just x | x == localDomain -> localsAndRemotes localDomain (qUnqualified <$> gpciStartingPoint) gpciSize
+    Just _ -> remotesOnly gpciStartingPoint $ fromRange gpciSize
+  where
+    localsAndRemotes :: Domain -> Maybe ConvId -> Range 1 1000 Int32 -> Galley (ConversationList (Qualified ConvId))
+    localsAndRemotes localDomain conv size = do
+      localPage <- resultSetToConvList . fmap (`Qualified` localDomain) <$> Data.conversationIdsFrom zusr conv size
+      let remainingSize = fromRange size - fromIntegral (length (Public.convList localPage))
+      if Public.convHasMore localPage
+        then pure localPage
+        else do
+          remotePage <- remotesOnly Nothing remainingSize
+          pure $ remotePage {convList = Public.convList localPage <> Public.convList remotePage}
+
+    remotesOnly :: Maybe (Qualified ConvId) -> Int32 -> Galley (ConversationList (Qualified ConvId))
+    remotesOnly start size =
+      resultSetToConvList <$> Data.remoteConversationIdsFrom zusr start size
+
+    resultSetToConvList :: Data.ResultSet a -> ConversationList a
+    resultSetToConvList res = Public.ConversationList (Data.resultSetResult res) (Data.resultSetType res == Data.ResultSetTruncated)
+
 getConversations :: UserId -> Maybe (Range 1 32 (CommaSeparatedList ConvId)) -> Maybe ConvId -> Maybe (Range 1 500 Int32) -> Galley (Public.ConversationList Public.Conversation)
 getConversations user mids mstart msize = do
   ConversationList cs more <- getConversationsInternal user mids mstart msize

services/galley/src/Galley/Data.hs

@@ -75,6 +75,7 @@ module Galley.Data
     updateConversationMessageTimer,
     deleteConversation,
     lookupReceiptMode,
+    remoteConversationIdsFrom,
 
     -- * Conversation Members
     addMember,
@@ -551,6 +552,30 @@ conversationIdsFrom usr start (fromRange -> max) =
   where
     strip p = p {result = take (fromIntegral max) (result p)}
 
+-- | When the 'start' parameter is set to 'Nothing', reads first 'max' records
+-- from 'user_remote_converstaions' table.
+--
+-- Otherwise, reads 'max' records starting from the 'start' parameter. Doing
+-- this is unfortunately not trivial, so this function first gets all the
+-- conversations which match the domain and then if there is still space, gets
+-- the conversations which have domain > domain of start.
+remoteConversationIdsFrom :: (MonadClient m, MonadLogger m) => UserId -> Maybe (Qualified ConvId) -> Int32 -> m (ResultSet (Qualified ConvId))
+remoteConversationIdsFrom usr start max =
+  case start of
+    Just (Qualified c d) -> do
+      domainPage <- toResultSet max <$> paginate Cql.selectUserRemoteConvsForDomainFrom (paramsP Quorum (usr, d, c) (max + 1))
+      let remainingMax = max - fromIntegral (length (resultSetResult domainPage))
+      if resultSetType domainPage == ResultSetTruncated
+        then pure domainPage
+        else do
+          nextPage <- toResultSet remainingMax <$> paginate Cql.selectUserRemoteConvsFromDomain (paramsP Quorum (usr, d) (remainingMax + 1))
+          pure $ nextPage {resultSetResult = resultSetResult domainPage <> resultSetResult nextPage}
+    Nothing ->
+      toResultSet max <$> paginate Cql.selectUserRemoteConvs (paramsP Quorum (Identity usr) (max + 1))
+  where
+    toResultSet max' = mkResultSet . strip max' . fmap (uncurry (flip Qualified))
+    strip max' p = p {result = take (fromIntegral max') (result p)}
+
 conversationIdRowsForPagination :: MonadClient m => UserId -> Maybe ConvId -> Range 1 1000 Int32 -> m (Page ConvId)
 conversationIdRowsForPagination usr start (fromRange -> max) =
   runIdentity

services/galley/src/Galley/Data/Queries.hs

@@ -307,6 +307,12 @@ insertUserRemoteConv = "insert into user_remote_conv (user, conv_remote_domain,
 selectUserRemoteConvs :: PrepQuery R (Identity UserId) (Domain, ConvId)
 selectUserRemoteConvs = "select conv_remote_domain, conv_remote_id from user_remote_conv where user = ? order by conv_remote_domain"
 
+selectUserRemoteConvsForDomainFrom :: PrepQuery R (UserId, Domain, ConvId) (Domain, ConvId)
+selectUserRemoteConvsForDomainFrom = "select conv_remote_domain, conv_remote_id from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id > ? order by conv_remote_domain"
+
+selectUserRemoteConvsFromDomain :: PrepQuery R (UserId, Domain) (Domain, ConvId)
+selectUserRemoteConvsFromDomain = "select conv_remote_domain, conv_remote_id from user_remote_conv where user = ? and conv_remote_domain > ? order by conv_remote_domain"
+
 selectRemoteConvMembership :: PrepQuery R (UserId, Domain, ConvId) (Identity UserId)
 selectRemoteConvMembership = "select user from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?"