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/cassandra-util/src/Cassandra.hs

@@ -30,6 +30,7 @@ import Cassandra.CQL as C
     Consistency (All, One, Quorum),
     Cql,
     Keyspace (Keyspace),
+    PagingState (..),
     QueryParams (QueryParams),
     QueryString (QueryString),
     R,
@@ -58,6 +59,7 @@ import Cassandra.Exec as C
     ClientState,
     MonadClient,
     Page (..),
+    PageWithState (..),
     PrepQuery,
     Row,
     addPrepQuery,
@@ -70,8 +72,11 @@ import Cassandra.Exec as C
     nextPage,
     paginate,
     paginateC,
+    paginateWithState,
     params,
     paramsP,
+    paramsPagingState,
+    pwsHasMore,
     query,
     query1,
     result,

libs/cassandra-util/src/Cassandra/CQL.hs

@@ -29,6 +29,7 @@ import Database.CQL.Protocol as C
     Consistency (All, One, Quorum),
     Cql,
     Keyspace (Keyspace),
+    PagingState (..),
     QueryParams (QueryParams),
     QueryString (QueryString),
     R,

libs/cassandra-util/src/Cassandra/Exec.hs

@@ -26,6 +26,10 @@ module Cassandra.Exec
     x1,
     syncCassandra,
     paginateC,
+    PageWithState (..),
+    paginateWithState,
+    paramsPagingState,
+    pwsHasMore,
     module C,
   )
 where
@@ -34,10 +38,11 @@ import Cassandra.CQL (Consistency, R)
 import Control.Monad.Catch
 import Data.Conduit
 -- We only use these locally.
-import Database.CQL.IO (RetrySettings, RunQ, defRetrySettings, eagerRetrySettings)
+import Database.CQL.IO (ProtocolError (UnexpectedResponse), RetrySettings, RunQ, defRetrySettings, eagerRetrySettings, getResult, hrHost, hrResponse, runQ)
 -- Things we just import and re-export.
 import Database.CQL.IO as C (BatchM, Client, ClientState, MonadClient, Page (..), PrepQuery, Row, addPrepQuery, addQuery, adjustConsistency, adjustResponseTimeout, adjustSendTimeout, batch, emptyPage, init, liftClient, localState, paginate, prepared, query, query1, queryString, retry, runClient, schema, setConsistency, setSerialConsistency, setType, shutdown, trans, write)
-import Database.CQL.Protocol (Error, QueryParams (QueryParams), Tuple)
+import Database.CQL.Protocol (Error, QueryParams (QueryParams), Tuple, pagingState)
+import qualified Database.CQL.Protocol as Protocol
 import Imports hiding (init)
 
 params :: Tuple a => Consistency -> a -> QueryParams a
@@ -100,3 +105,29 @@ paginateC q p r = go =<< lift (retry r (paginate q p))
         yield (result page)
       when (hasMore page) $
         go =<< lift (retry r (liftClient (nextPage page)))
+
+data PageWithState a = PageWithState
+  { pwsResults :: [a],
+    pwsState :: Maybe Protocol.PagingState
+  }
+  deriving (Functor)
+
+-- | Like 'paginate' but exposes the paging state. This paging state can be
+-- serialised and sent to consumers of the API. The state is not good for long
+-- term storage as the bytestring format may change when the schema of a table
+-- changes or when cassandra is upgraded.
+paginateWithState :: (MonadClient m, Tuple a, Tuple b, RunQ q) => q R a b -> QueryParams a -> m (PageWithState b)
+paginateWithState q p = do
+  let p' = p {Protocol.pageSize = Protocol.pageSize p <|> Just 10000}
+  r <- runQ q p'
+  getResult r >>= \case
+    Protocol.RowsResult m b ->
+      return $ PageWithState b (pagingState m)
+    _ -> throwM $ UnexpectedResponse (hrHost r) (hrResponse r)
+
+paramsPagingState :: Consistency -> a -> Int32 -> Maybe Protocol.PagingState -> QueryParams a
+paramsPagingState c p n state = QueryParams c False p (Just n) state Nothing Nothing
+{-# INLINE paramsPagingState #-}
+
+pwsHasMore :: PageWithState a -> Bool
+pwsHasMore = isJust . pwsState

libs/types-common/src/Data/Json/Util.hs

@@ -37,6 +37,7 @@ module Data.Json.Util
     -- * Base64
     Base64ByteString (..),
     fromBase64TextLenient,
+    fromBase64Text,
     toBase64Text,
   )
 where
@@ -200,5 +201,8 @@ instance Arbitrary Base64ByteString where
 fromBase64TextLenient :: Text -> ByteString
 fromBase64TextLenient = B64.decodeLenient . Text.encodeUtf8
 
+fromBase64Text :: Text -> Either String ByteString
+fromBase64Text = B64.decode . Text.encodeUtf8
+
 toBase64Text :: ByteString -> Text
 toBase64Text = Text.decodeUtf8 . B64.encode

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.
@@ -18,14 +19,18 @@
 -- 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/>.
 
--- FUTUREWORK:
--- There's still a lot of stuff we should factor out into separate modules.
+-- FUTUREWORK: There's still a lot of stuff we should factor out into separate
+-- modules.
 module Wire.API.Conversation
   ( -- * Conversation
     Conversation (..),
     ConversationCoverView (..),
     ConversationList (..),
     ListConversations (..),
+    GetPaginatedConversationIds (..),
+    ConversationPagingState (..),
+    ConversationPagingTable (..),
+    ConvIdsPage (..),
 
     -- * Conversation properties
     Access (..),
@@ -73,13 +78,16 @@ import Control.Applicative
 import Control.Lens (at, (?~))
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as A
+import qualified Data.Attoparsec.ByteString as AB
+import qualified Data.ByteString as BS
 import Data.Id
+import Data.Json.Util (fromBase64Text, toBase64Text)
 import Data.List.NonEmpty (NonEmpty)
 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 +233,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 +263,85 @@ instance FromJSON a => FromJSON (ConversationList a) where
       <$> o A..: "conversations"
       <*> o A..: "has_more"
 
+data ConvIdsPage = ConvIdsPage
+  { pageConvIds :: [Qualified ConvId],
+    pageHasMore :: Bool,
+    pagePagingState :: ConversationPagingState
+  }
+  deriving (Show, Eq, Generic)
+  deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConvIdsPage
+
+instance ToSchema ConvIdsPage where
+  schema =
+    object "ConvIdsPage" $
+      ConvIdsPage
+        <$> pageConvIds .= field "qualified_conversations" (array schema)
+        <*> pageHasMore .= field "has_more" schema
+        <*> pagePagingState .= field "paging_state" schema
+
+data ConversationPagingState = ConversationPagingState
+  { cpsTable :: ConversationPagingTable,
+    cpsPagingState :: Maybe ByteString
+  }
+  deriving (Show, Eq)
+  deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationPagingState
+
+instance ToSchema ConversationPagingState where
+  schema =
+    (toBase64Text . encodeConversationPagingState)
+      .= parsedText "ConversationPagingState" (parseConvesationPagingState <=< fromBase64Text)
+
+parseConvesationPagingState :: ByteString -> Either String ConversationPagingState
+parseConvesationPagingState = AB.parseOnly conversationPagingStateParser
+
+conversationPagingStateParser :: AB.Parser ConversationPagingState
+conversationPagingStateParser = do
+  cpsTable <- tableParser
+  cpsPagingState <- (AB.endOfInput $> Nothing) <|> (Just <$> AB.takeByteString <* AB.endOfInput)
+  pure ConversationPagingState {..}
+  where
+    tableParser :: AB.Parser ConversationPagingTable
+    tableParser =
+      (AB.word8 0 $> PagingLocals)
+        <|> (AB.word8 1 $> PagingRemotes)
+
+encodeConversationPagingState :: ConversationPagingState -> ByteString
+encodeConversationPagingState ConversationPagingState {..} =
+  let table = encodeConversationPagingTable cpsTable
+      state = fromMaybe "" cpsPagingState
+   in BS.cons table state
+
+encodeConversationPagingTable :: ConversationPagingTable -> Word8
+encodeConversationPagingTable = \case
+  PagingLocals -> 0
+  PagingRemotes -> 1
+
+data ConversationPagingTable
+  = PagingLocals
+  | PagingRemotes
+  deriving (Show, Eq)
+
+data GetPaginatedConversationIds = GetPaginatedConversationIds
+  { gpciPagingState :: Maybe ConversationPagingState,
+    gpciSize :: Range 1 1000 Int32
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving (FromJSON, ToJSON, S.ToSchema) via Schema GetPaginatedConversationIds
+
+instance ToSchema GetPaginatedConversationIds where
+  schema =
+    let addPagingStateDoc =
+          description
+            ?~ "optional, when not specified first page of the conversation ids will be returned.\
+               \Every returned page contains a paging_state, this should be supplied to retrieve the next page."
+        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
+            <$> gpciPagingState .= optFieldWithDocModifier "paging_state" Nothing addPagingStateDoc 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

@@ -126,9 +126,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"
@@ -148,6 +148,15 @@ data Api routes = Api
              "size"
              (Range 1 1000 Int32)
         :> Get '[Servant.JSON] (Public.ConversationList ConvId),
+    listConversationIds ::
+      routes
+        :- Summary "Get all conversation IDs."
+          :> Description "To retrieve the next page, a client must pass the paging_state returned by the previous page."
+          :> ZUser
+          :> "conversations"
+          :> "list-ids"
+          :> ReqBody '[Servant.JSON] Public.GetPaginatedConversationIds
+          :> Post '[Servant.JSON] Public.ConvIdsPage,
     getConversations ::
       routes
         :- Summary "Get all *local* conversations."

libs/wire-api/test/golden/testObject_ConvIdsPage_1.json

@@ -0,0 +1,5 @@
+{
+    "has_more": false,
+    "paging_state": "AA==",
+    "qualified_conversations": []
+}

libs/wire-api/test/golden/testObject_ConvIdsPage_2.json

@@ -0,0 +1,10 @@
+{
+    "has_more": true,
+    "paging_state": "AA==",
+    "qualified_conversations": [
+        {
+            "domain": "domain.example.com",
+            "id": "00000018-0000-0020-0000-000e00000002"
+        }
+    ]
+}

libs/wire-api/test/golden/testObject_ConversationPagingState_1.json

@@ -0,0 +1 @@
+"AA=="

libs/wire-api/test/golden/testObject_ConversationPagingState_2.json

@@ -0,0 +1 @@
+"AAABWGN9WA=="

libs/wire-api/test/golden/testObject_ConversationPagingState_3.json

@@ -0,0 +1 @@
+"AQ=="

libs/wire-api/test/golden/testObject_ConversationPagingState_4.json

@@ -0,0 +1 @@
+"AVgMFw=="

libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_1.json

@@ -0,0 +1,3 @@
+{
+    "size": 50
+}

libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_2.json

@@ -0,0 +1,4 @@
+{
+    "size": 1000,
+    "paging_state": "AA=="
+}

libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs

@@ -22,8 +22,11 @@ import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Wire.API.Golden.Manual.ClientCapability
 import Test.Wire.API.Golden.Manual.ClientCapabilityList
+import Test.Wire.API.Golden.Manual.ConvIdsPage
 import Test.Wire.API.Golden.Manual.ConversationCoverView
+import Test.Wire.API.Golden.Manual.ConversationPagingState
 import Test.Wire.API.Golden.Manual.FeatureConfigEvent
+import Test.Wire.API.Golden.Manual.GetPaginatedConversationIds
 import Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap
 import Test.Wire.API.Golden.Manual.UserClientPrekeyMap
 import Test.Wire.API.Golden.Runner
@@ -54,6 +57,23 @@ tests =
             (testObject_ConversationCoverView_2, "testObject_ConversationCoverView_2.json"),
             (testObject_ConversationCoverView_3, "testObject_ConversationCoverView_3.json")
           ],
+      testCase "GetPaginatedConversationIds" $
+        testObjects
+          [ (testObject_GetPaginatedConversationIds_1, "testObject_GetPaginatedConversationIds_1.json"),
+            (testObject_GetPaginatedConversationIds_2, "testObject_GetPaginatedConversationIds_2.json")
+          ],
+      testCase "ConversationPagingState" $
+        testObjects
+          [ (testObject_ConversationPagingState_1, "testObject_ConversationPagingState_1.json"),
+            (testObject_ConversationPagingState_2, "testObject_ConversationPagingState_2.json"),
+            (testObject_ConversationPagingState_3, "testObject_ConversationPagingState_3.json"),
+            (testObject_ConversationPagingState_4, "testObject_ConversationPagingState_4.json")
+          ],
+      testCase "ConvIdsPage" $
+        testObjects
+          [ (testObject_ConvIdsPage_1, "testObject_ConvIdsPage_1.json"),
+            (testObject_ConvIdsPage_2, "testObject_ConvIdsPage_2.json")
+          ],
       testCase "ClientCapability" $
         testObjects
           [(testObject_ClientCapability_1, "testObject_ClientCapability_1.json")],

libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConvIdsPage.hs

@@ -0,0 +1,15 @@
+module Test.Wire.API.Golden.Manual.ConvIdsPage where
+
+import Data.Domain (Domain (Domain))
+import Data.Id (Id (Id))
+import Data.Qualified
+import qualified Data.UUID as UUID
+import Imports
+import Test.Wire.API.Golden.Manual.ConversationPagingState (testObject_ConversationPagingState_1)
+import Wire.API.Conversation
+
+testObject_ConvIdsPage_1 :: ConvIdsPage
+testObject_ConvIdsPage_1 = ConvIdsPage [] False testObject_ConversationPagingState_1
+
+testObject_ConvIdsPage_2 :: ConvIdsPage
+testObject_ConvIdsPage_2 = ConvIdsPage [Qualified (Id (fromJust (UUID.fromString "00000018-0000-0020-0000-000e00000002"))) (Domain "domain.example.com")] True testObject_ConversationPagingState_1