From b96e1689f8499c58756b9e3a1372617fd01cd1b7 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 28 Jul 2021 17:05:15 +0200 Subject: [PATCH 01/31] [WIP] Create new endpoint to get paginated conv ids --- libs/wire-api/src/Wire/API/Conversation.hs | 27 +++++- .../src/Wire/API/Routes/Public/Galley.hs | 11 ++- services/galley/src/Galley/API/Public.hs | 1 + services/galley/src/Galley/API/Query.hs | 11 +++ services/galley/test/integration/API.hs | 89 ++++++++++++++++--- services/galley/test/integration/API/Util.hs | 12 +++ 6 files changed, 135 insertions(+), 16 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index c4b8b627f7a..e69170c853e 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index b28d04f27fa..92801695b8c 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -142,7 +142,7 @@ data Api routes = Api :> Get '[Servant.JSON] Public.ConversationRolesList, getConversationIds :: routes - :- Summary "Get all conversation IDs." + :- Summary "Get all local conversation IDs." -- FUTUREWORK: add bounds to swagger schema for Range :> ZUser :> "conversations" @@ -162,6 +162,15 @@ data Api routes = Api "size" (Range 1 1000 Int32) :> Get '[Servant.JSON] (Public.ConversationList ConvId), + getConversationIdsV2 :: + routes + :- Summary "Get all conversation IDs." + :> ZUser + :> "conversations" + :> "ids" + :> "v2" + :> ReqBody '[Servant.JSON] Public.GetPaginatedConversationIds + :> Post '[Servant.JSON] (Public.ConversationList (Qualified ConvId)), getConversations :: routes :- Summary "Get all *local* conversations." diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index b2b5ffb1474..0203eae116c 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -81,6 +81,7 @@ servantSitemap = GalleyAPI.getConversation = Query.getConversation, GalleyAPI.getConversationRoles = Query.getConversationRoles, GalleyAPI.getConversationIds = Query.getConversationIds, + GalleyAPI.getConversationIdsV2 = Query.getConversationIdsV2, GalleyAPI.getConversations = Query.getConversations, GalleyAPI.getConversationByReusableCode = Query.getConversationByReusableCode, GalleyAPI.listConversations = Query.listConversations, diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index eafebb67281..ddae0905e41 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -14,6 +14,7 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# LANGUAGE RecordWildCards #-} module Galley.API.Query ( getBotConversationH, @@ -21,6 +22,7 @@ module Galley.API.Query getConversation, getConversationRoles, getConversationIds, + getConversationIdsV2, getConversations, listConversations, iterateConversations, @@ -127,6 +129,15 @@ getConversationIds zusr start msize = do (Data.resultSetResult ids) (Data.resultSetType ids == Data.ResultSetTruncated) +getConversationIdsV2 :: UserId -> Public.GetPaginatedConversationIds -> Galley (Public.ConversationList (Qualified ConvId)) +getConversationIdsV2 zusr Public.GetPaginatedConversationIds {..} = do + ids <- Data.conversationIdsFrom zusr Nothing gpciSize + localDomain <- viewFederationDomain + pure $ + Public.ConversationList + (map (`Qualified` localDomain) $ Data.resultSetResult ids) + (Data.resultSetType ids == 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 diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index d950cf252ca..f3f7f636b62 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -50,6 +50,7 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.List1 import qualified Data.List1 as List1 import qualified Data.Map.Strict as Map +import Data.Proxy (Proxy (..)) import Data.Qualified import Data.Range import qualified Data.Set as Set @@ -116,7 +117,9 @@ tests s = test s "list-conversations by ids" listConvsOk2, test s "fail to get >500 conversations" getConvsFailMaxSize, test s "get conversation ids" getConvIdsOk, + test s "get conversation ids v2" getConvIdsV2Ok, test s "paginate through conversation ids" paginateConvIds, + test s "paginate through conversation ids v2" paginateConvIdsV2, test s "fail to get >1000 conversation ids" getConvIdsFailMaxSize, test s "page through conversations" getConvsPagingOk, test s "page through list-conversations (local conversations only)" listConvsPagingOk, @@ -667,12 +670,12 @@ postMessageQualifiedLocalOwningBackendRedundantAndDeletedClients = do let expectedRedundant = QualifiedUserClients . Map.fromList $ [ ( owningDomain, - Map.fromList $ + Map.fromList [ (nonMemberUnqualified, Set.singleton nonMemberOwningDomainClient) ] ), ( remoteDomain, - Map.fromList $ + Map.fromList [ (nonMemberRemoteUnqualified, Set.singleton nonMemberRemoteClient) ] ) @@ -1239,6 +1242,38 @@ getConvIdsFailMaxSize = do getConvIds usr Nothing (Just 1001) !!! const 400 === statusCode +getConvIdsV2Ok :: TestM () +getConvIdsV2Ok = do + [alice, bob] <- randomUsers 2 + connectUsers alice (singleton bob) + void $ postO2OConv alice bob (Just "gossip") + let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) + getConvIdsV2 alice paginationOpts !!! do + const 200 === statusCode + const (Right 2) === fmap length . decodeQualifiedConvIdList + getConvIdsV2 bob paginationOpts !!! do + const 200 === statusCode + const (Right 2) === fmap length . decodeQualifiedConvIdList + +paginateConvIdsV2 :: TestM () +paginateConvIdsV2 = do + [alice, bob, eve] <- randomUsers 3 + connectUsers alice (singleton bob) + connectUsers alice (singleton eve) + replicateM_ 256 $ + postConv alice [bob, eve] (Just "gossip") [] Nothing Nothing + !!! const 201 === statusCode + foldM_ (getChunk 16 alice) Nothing [15 .. 0 :: Int] + where + getChunk size alice start n = do + let paginationOpts = GetPaginatedConversationIds start (unsafeRange size) + resp <- getConvIdsV2 alice paginationOpts 0 + return $ last (convList c) + getConvsPagingOk :: TestM () getConvsPagingOk = do [ally, bill, carl] <- randomUsers 3 @@ -1290,6 +1325,32 @@ listConvsPagingOk = do liftIO $ assertBool "getConvIds /= getConvs" (ids1 == ids3) return $ ids1 >>= listToMaybe . reverse +-- listConvsRemotePagingOk :: TestM () +-- listConvsRemotePagingOk = do +-- [ally, bill, carl] <- randomUsers 3 +-- connectUsers ally (list1 bill [carl]) +-- replicateM_ 11 $ postConv ally [bill, carl] (Just "gossip") [] Nothing Nothing +-- walk ally [3, 3, 3, 3, 2] -- 11 (group) + 2 (1:1) + 1 (self) +-- walk bill [3, 3, 3, 3, 1] -- 11 (group) + 1 (1:1) + 1 (self) +-- walk carl [3, 3, 3, 3, 1] -- 11 (group) + 1 (1:1) + 1 (self) +-- where +-- walk :: Foldable t => UserId -> t Int -> TestM () +-- walk u = foldM_ (next u 3) Nothing +-- next :: UserId -> Int32 -> Maybe ConvId -> Int -> TestM (Maybe ConvId) +-- next u step start n = do +-- -- FUTUREWORK: support an endpoint to get qualified conversation IDs +-- -- (without all the conversation metadata) +-- r1 <- getConvIds u (Right <$> start) (Just step) responseJsonUnsafe r1 +-- liftIO $ assertEqual "unexpected length (getConvIds)" (Just n) (length <$> ids1) +-- localDomain <- viewFederationDomain +-- let requestBody = ListConversations Nothing (flip Qualified localDomain <$> start) (Just (unsafeRange step)) +-- r2 <- listConvs u requestBody responseJsonUnsafe r2 +-- liftIO $ assertEqual "unexpected length (getConvs)" (Just n) (length <$> ids3) +-- liftIO $ assertBool "getConvIds /= getConvs" (ids1 == ids3) +-- return $ ids1 >>= listToMaybe . reverse + postConvFailNotConnected :: TestM () postConvFailNotConnected = do alice <- randomUser @@ -1312,7 +1373,7 @@ postConvFailNumMembers :: TestM () postConvFailNumMembers = do n <- fromIntegral <$> view tsMaxConvSize alice <- randomUser - bob : others <- replicateM n (randomUser) + bob : others <- replicateM n randomUser connectUsers alice (list1 bob others) postConv alice (bob : others) Nothing [] Nothing Nothing !!! do const 400 === statusCode @@ -1504,7 +1565,7 @@ postRepeatConnectConvCancel = do let cnv = responseJsonUnsafeWithMsg "conversation" rsp1 liftIO $ do ConnectConv @=? cnvType cnv - (Just "A") @=? cnvName cnv + Just "A" @=? cnvName cnv [] @=? cmOthers (cnvMembers cnv) privateAccess @=? cnvAccess cnv -- Alice blocks / cancels @@ -1514,7 +1575,7 @@ postRepeatConnectConvCancel = do let cnv2 = responseJsonUnsafeWithMsg "conversation" rsp2 liftIO $ do ConnectConv @=? cnvType cnv2 - (Just "A2") @=? cnvName cnv2 + Just "A2" @=? cnvName cnv2 [] @=? cmOthers (cnvMembers cnv2) privateAccess @=? cnvAccess cnv2 -- Alice blocks / cancels again @@ -1524,7 +1585,7 @@ postRepeatConnectConvCancel = do let cnv3 = responseJsonUnsafeWithMsg "conversation" rsp3 liftIO $ do ConnectConv @=? cnvType cnv3 - (Just "B") @=? cnvName cnv3 + Just "B" @=? cnvName cnv3 privateAccess @=? cnvAccess cnv3 -- Bob accepting is a no-op, since he is already a member let convId = qUnqualified . cnvQualifiedId $ cnv @@ -1532,14 +1593,14 @@ postRepeatConnectConvCancel = do cnvX <- responseJsonUnsafeWithMsg "conversation" <$> getConv bob convId liftIO $ do ConnectConv @=? cnvType cnvX - (Just "B") @=? cnvName cnvX + Just "B" @=? cnvName cnvX privateAccess @=? cnvAccess cnvX -- Alice accepts, finally turning it into a 1-1 putConvAccept alice convId !!! const 200 === statusCode cnv4 <- responseJsonUnsafeWithMsg "conversation" <$> getConv alice convId liftIO $ do One2OneConv @=? cnvType cnv4 - (Just "B") @=? cnvName cnv4 + Just "B" @=? cnvName cnv4 privateAccess @=? cnvAccess cnv4 where cancel u c = do @@ -1620,7 +1681,7 @@ leaveConnectConversation = do alice <- randomUser bob <- randomUser bdy <- postConnectConv alice bob "alice" "ni" Nothing responseJsonUnsafe bdy) + let c = maybe (error "invalid connect conversation") (qUnqualified . cnvQualifiedId) (responseJsonUnsafe bdy) deleteMember alice alice c !!! const 403 === statusCode -- FUTUREWORK: Add more tests for scenarios of federation. @@ -1806,7 +1867,7 @@ testAddRemoteMemberFederationDisabled = do -- federator endpoint not configured is equivalent to federation being disabled -- This is the case on staging/production in May 2021. let federatorNotConfigured :: Opts = opts & optFederator .~ Nothing - withSettingsOverrides federatorNotConfigured $ do + withSettingsOverrides federatorNotConfigured $ postQualifiedMembers' g alice (remoteBob :| []) convId !!! do const 400 === statusCode const (Just "federation-not-enabled") === fmap label . responseJsonUnsafe @@ -1815,7 +1876,7 @@ testAddRemoteMemberFederationDisabled = do -- misconfiguration of federator. That should give a 500. -- Port 1 should always be wrong hopefully. let federatorUnavailable :: Opts = opts & optFederator ?~ Endpoint "127.0.0.1" 1 - withSettingsOverrides federatorUnavailable $ do + withSettingsOverrides federatorUnavailable $ postQualifiedMembers' g alice (remoteBob :| []) convId !!! do const 500 === statusCode const (Just "federation-not-available") === fmap label . responseJsonUnsafe @@ -2002,12 +2063,12 @@ putMemberOk update = do Member { memId = bob, memService = Nothing, - memOtrMuted = fromMaybe False (mupOtrMute update), + memOtrMuted = Just True == (mupOtrMute update), memOtrMutedStatus = mupOtrMuteStatus update, memOtrMutedRef = mupOtrMuteRef update, - memOtrArchived = fromMaybe False (mupOtrArchive update), + memOtrArchived = Just True == (mupOtrArchive update), memOtrArchivedRef = mupOtrArchiveRef update, - memHidden = fromMaybe False (mupHidden update), + memHidden = Just True == (mupHidden update), memHiddenRef = mupHiddenRef update, memConvRoleName = fromMaybe roleNameWireAdmin (mupConvRoleName update) } diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index f52b2b2fdbd..b0c9a45f12c 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -834,6 +834,15 @@ getConvIds u r s = do . zType "access" . convRange r s +getConvIdsV2 :: UserId -> Public.GetPaginatedConversationIds -> TestM ResponseLBS +getConvIdsV2 u paginationOpts = do + g <- view tsGalley + post $ + g + . path "/conversations/ids/v2" + . zUser u + . json paginationOpts + postQualifiedMembers :: UserId -> NonEmpty (Qualified UserId) -> ConvId -> TestM ResponseLBS postQualifiedMembers zusr invitees conv = do g <- view tsGalley @@ -1286,6 +1295,9 @@ decodeConvList = convList . responseJsonUnsafeWithMsg "conversations" decodeConvIdList :: Response (Maybe Lazy.ByteString) -> [ConvId] decodeConvIdList = convList . responseJsonUnsafeWithMsg "conversation-ids" +decodeQualifiedConvIdList :: Response (Maybe Lazy.ByteString) -> Either String [Qualified ConvId] +decodeQualifiedConvIdList = fmap convList . responseJsonEither + zUser :: UserId -> Request -> Request zUser = header "Z-User" . toByteString' From b059cfa6f4ee9c27f673255cedc19bfd910f9042 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 2 Aug 2021 17:00:29 +0200 Subject: [PATCH 02/31] Fix old test so it actaully asserts --- services/galley/test/integration/API.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index f3f7f636b62..99f8cc5f7da 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1223,17 +1223,27 @@ paginateConvIds = do [alice, bob, eve] <- randomUsers 3 connectUsers alice (singleton bob) connectUsers alice (singleton eve) - replicateM_ 256 $ + replicateM_ 253 $ postConv alice [bob, eve] (Just "gossip") [] Nothing Nothing !!! const 201 === statusCode - foldM_ (getChunk 16 alice) Nothing [15 .. 0 :: Int] + -- 1 self conv, 2 convs with bob and eve, 253 gossips = 256 convs + foldM_ (getChunk 16 alice) Nothing [15, 14 .. 0 :: Int] where getChunk size alice start n = do resp <- getConvIds alice start (Just size) 0 + -- This is because of the way this test is setup, we always get 16 + -- convs, even on the last one + assertEqual + ("Number of convs should match the requested size, " <> show n <> " more gets to go") + (fromIntegral size) + (length (convList c)) + + if n > 0 + then assertEqual "hasMore should be True" True (convHasMore c) + else assertEqual ("hasMore should be False, " <> show n <> " more chunks to go") False (convHasMore c) + return (Just (Right (last (convList c)))) getConvIdsFailMaxSize :: TestM () From 157045ed101e894d0bec4814d1cbe5d9596a229e Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 2 Aug 2021 17:07:35 +0200 Subject: [PATCH 03/31] Add failing test It doesn't fail the way I want it tho! --- services/galley/test/integration/API.hs | 58 +++++++++++++++++++++++-- 1 file changed, 54 insertions(+), 4 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 99f8cc5f7da..3ea1a695617 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1270,18 +1270,68 @@ paginateConvIdsV2 = do [alice, bob, eve] <- randomUsers 3 connectUsers alice (singleton bob) connectUsers alice (singleton eve) - replicateM_ 256 $ + localDomain <- viewFederationDomain + let qAlice = Qualified alice localDomain + now <- liftIO getCurrentTime + fedGalleyClient <- view tsFedGalleyClient + + replicateM_ 197 $ postConv alice [bob, eve] (Just "gossip") [] Nothing Nothing !!! const 201 === statusCode - foldM_ (getChunk 16 alice) Nothing [15 .. 0 :: Int] + + remoteChad <- randomId + let chadDomain = Domain "chad.example.com" + qChad = Qualified remoteChad chadDomain + replicateM_ 25 $ do + conv <- randomId + let cmu = + FederatedGalley.ConversationMemberUpdate + { FederatedGalley.cmuTime = now, + FederatedGalley.cmuOrigUserId = qChad, + FederatedGalley.cmuConvId = Qualified conv chadDomain, + FederatedGalley.cmuAlreadyPresentUsers = [], + FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], + FederatedGalley.cmuUsersRemove = [] + } + FederatedGalley.updateConversationMemberships fedGalleyClient cmu + + remoteDee <- randomId + let deeDomain = Domain "dee.example.com" + qDee = Qualified remoteDee deeDomain + replicateM_ 31 $ do + conv <- randomId + let cmu = + FederatedGalley.ConversationMemberUpdate + { FederatedGalley.cmuTime = now, + FederatedGalley.cmuOrigUserId = qDee, + FederatedGalley.cmuConvId = Qualified conv deeDomain, + FederatedGalley.cmuAlreadyPresentUsers = [], + FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], + FederatedGalley.cmuUsersRemove = [] + } + FederatedGalley.updateConversationMemberships fedGalleyClient cmu + + -- 1 self conv + 2 convs with bob and eve + 197 local convs + 25 convs on + -- chad.example.com + 31 on dee.example = 256 convs. Getting them 16 at a time + -- should get all them in 16 times. + foldM_ (getChunk 16 alice) Nothing [15, 14 .. 0 :: Int] where getChunk size alice start n = do let paginationOpts = GetPaginatedConversationIds start (unsafeRange size) resp <- getConvIdsV2 alice paginationOpts 0 + -- This is because of the way this test is setup, we always get 16 + -- convs, even on the last one + assertEqual + ("Number of convs should match the requested size, " <> show n <> " more gets to go") + (fromIntegral size) + (length (convList c)) + + if n > 0 + then assertEqual "hasMore should be True" True (convHasMore c) + else assertEqual ("hasMore should be False, " <> show n <> " more chunks to go") False (convHasMore c) + return $ last (convList c) getConvsPagingOk :: TestM () From 4b096a12fb74de33ed90b87fef8f9b109bd337f4 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 12:42:56 +0200 Subject: [PATCH 04/31] Implement paginated get remote conversations --- services/galley/src/Galley/API/Query.hs | 27 +++++-- services/galley/src/Galley/Data.hs | 18 +++++ services/galley/src/Galley/Data/Queries.hs | 7 ++ services/galley/test/integration/API.hs | 93 ++++++++++++++++++---- 4 files changed, 123 insertions(+), 22 deletions(-) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index ddae0905e41..3534842c600 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -131,12 +131,29 @@ getConversationIds zusr start msize = do getConversationIdsV2 :: UserId -> Public.GetPaginatedConversationIds -> Galley (Public.ConversationList (Qualified ConvId)) getConversationIdsV2 zusr Public.GetPaginatedConversationIds {..} = do - ids <- Data.conversationIdsFrom zusr Nothing gpciSize localDomain <- viewFederationDomain - pure $ - Public.ConversationList - (map (`Qualified` localDomain) $ Data.resultSetResult ids) - (Data.resultSetType ids == Data.ResultSetTruncated) + 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 diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 84175711055..644615184b3 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -75,6 +75,7 @@ module Galley.Data updateConversationMessageTimer, deleteConversation, lookupReceiptMode, + remoteConversationIdsFrom, -- * Conversation Members addMember, @@ -551,6 +552,23 @@ conversationIdsFrom usr start (fromRange -> max) = where strip p = p {result = take (fromIntegral max) (result p)} +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 diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index 6af659366bc..81a16a0c44c 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -307,9 +307,16 @@ 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 = ?" + -- FUTUREWORK: actually make use of these cql statements. deleteUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () deleteUserRemoteConv = "delete from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 3ea1a695617..3d812ecbadc 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -120,6 +120,7 @@ tests s = test s "get conversation ids v2" getConvIdsV2Ok, test s "paginate through conversation ids" paginateConvIds, test s "paginate through conversation ids v2" paginateConvIdsV2, + test s "paginate through conversation ids v2 - page ending at locals and remote domain" paginateConvIdsV2PageEndingAtLocalsAndDomain, test s "fail to get >1000 conversation ids" getConvIdsFailMaxSize, test s "page through conversations" getConvsPagingOk, test s "page through list-conversations (local conversations only)" listConvsPagingOk, @@ -1314,25 +1315,83 @@ paginateConvIdsV2 = do -- 1 self conv + 2 convs with bob and eve + 197 local convs + 25 convs on -- chad.example.com + 31 on dee.example = 256 convs. Getting them 16 at a time -- should get all them in 16 times. - foldM_ (getChunk 16 alice) Nothing [15, 14 .. 0 :: Int] - where - getChunk size alice start n = do - let paginationOpts = GetPaginatedConversationIds start (unsafeRange size) - resp <- getConvIdsV2 alice paginationOpts show n <> " more gets to go") - (fromIntegral size) - (length (convList c)) + foldM_ (getChunkedConvs 16 alice) Nothing [15, 14 .. 0 :: Int] - if n > 0 - then assertEqual "hasMore should be True" True (convHasMore c) - else assertEqual ("hasMore should be False, " <> show n <> " more chunks to go") False (convHasMore c) +-- This test exists +paginateConvIdsV2PageEndingAtLocalsAndDomain :: TestM () +paginateConvIdsV2PageEndingAtLocalsAndDomain = do + [alice, bob, eve] <- randomUsers 3 + connectUsers alice (singleton bob) + connectUsers alice (singleton eve) + localDomain <- viewFederationDomain + let qAlice = Qualified alice localDomain + now <- liftIO getCurrentTime + fedGalleyClient <- view tsFedGalleyClient + + -- With page size 16, 29 group convs + 3 one-to-one convs, we get 32 convs. + -- The 2nd page should end here. + replicateM_ 29 $ + postConv alice [bob, eve] (Just "gossip") [] Nothing Nothing + !!! const 201 === statusCode + + -- We should be able to page through current state in 2 pages exactly + foldM_ (getChunkedConvs 16 alice) Nothing [1, 0 :: Int] + + remoteChad <- randomId + let chadDomain = Domain "chad.example.com" + qChad = Qualified remoteChad chadDomain + -- The 3rd page will end with this domain + replicateM_ 16 $ do + conv <- randomId + let cmu = + FederatedGalley.ConversationMemberUpdate + { FederatedGalley.cmuTime = now, + FederatedGalley.cmuOrigUserId = qChad, + FederatedGalley.cmuConvId = Qualified conv chadDomain, + FederatedGalley.cmuAlreadyPresentUsers = [], + FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], + FederatedGalley.cmuUsersRemove = [] + } + FederatedGalley.updateConversationMemberships fedGalleyClient cmu + + remoteDee <- randomId + let deeDomain = Domain "dee.example.com" + qDee = Qualified remoteDee deeDomain + -- The 4th and last page will end with this domain + replicateM_ 16 $ do + conv <- randomId + let cmu = + FederatedGalley.ConversationMemberUpdate + { FederatedGalley.cmuTime = now, + FederatedGalley.cmuOrigUserId = qDee, + FederatedGalley.cmuConvId = Qualified conv deeDomain, + FederatedGalley.cmuAlreadyPresentUsers = [], + FederatedGalley.cmuUsersAdd = [(qAlice, roleNameWireMember)], + FederatedGalley.cmuUsersRemove = [] + } + FederatedGalley.updateConversationMemberships fedGalleyClient cmu + + foldM_ (getChunkedConvs 16 alice) Nothing [3, 2, 1, 0 :: Int] + +getChunkedConvs :: (Typeable a, FromJSON a) => Int32 -> UserId -> Maybe (Qualified ConvId) -> Int -> TestM a +getChunkedConvs size alice start n = do + let paginationOpts = GetPaginatedConversationIds start (unsafeRange size) + print paginationOpts + resp <- getConvIdsV2 alice paginationOpts show n <> " more gets to go") + (fromIntegral size) + (length (convList c)) + + if n > 0 + then assertEqual ("hasMore should be True, " <> show n <> " more chunk(s) to go") True (convHasMore c) + else assertEqual "hasMore should be False, no more chunks to go" False (convHasMore c) - return $ last (convList c) + return $ last (convList c) getConvsPagingOk :: TestM () getConvsPagingOk = do From febb54bfdbbaf59dddca4172ef23eec5e94c627d Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 13:08:00 +0200 Subject: [PATCH 05/31] Rename /convs/ids/v2 -> /convs/list-ids --- .../src/Wire/API/Routes/Public/Galley.hs | 3 +-- services/galley/test/integration/API.hs | 24 +++++++++---------- services/galley/test/integration/API/Util.hs | 6 ++--- 3 files changed, 16 insertions(+), 17 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 92801695b8c..495dce2a36a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -167,8 +167,7 @@ data Api routes = Api :- Summary "Get all conversation IDs." :> ZUser :> "conversations" - :> "ids" - :> "v2" + :> "list-ids" :> ReqBody '[Servant.JSON] Public.GetPaginatedConversationIds :> Post '[Servant.JSON] (Public.ConversationList (Qualified ConvId)), getConversations :: diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 3d812ecbadc..8cf388492a8 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -117,10 +117,10 @@ tests s = test s "list-conversations by ids" listConvsOk2, test s "fail to get >500 conversations" getConvsFailMaxSize, test s "get conversation ids" getConvIdsOk, - test s "get conversation ids v2" getConvIdsV2Ok, + test s "get conversation ids v2" listConvIdsOk, test s "paginate through conversation ids" paginateConvIds, - test s "paginate through conversation ids v2" paginateConvIdsV2, - test s "paginate through conversation ids v2 - page ending at locals and remote domain" paginateConvIdsV2PageEndingAtLocalsAndDomain, + test s "paginate through /converstaions/list-ids" pageinateConvListIds, + test s "paginate through /conversations/list-ids - page ending at locals and remote domain" pageinateConvListIdsPageEndingAtLocalsAndDomain, test s "fail to get >1000 conversation ids" getConvIdsFailMaxSize, test s "page through conversations" getConvsPagingOk, test s "page through list-conversations (local conversations only)" listConvsPagingOk, @@ -1253,21 +1253,21 @@ getConvIdsFailMaxSize = do getConvIds usr Nothing (Just 1001) !!! const 400 === statusCode -getConvIdsV2Ok :: TestM () -getConvIdsV2Ok = do +listConvIdsOk :: TestM () +listConvIdsOk = do [alice, bob] <- randomUsers 2 connectUsers alice (singleton bob) void $ postO2OConv alice bob (Just "gossip") let paginationOpts = GetPaginatedConversationIds Nothing (toRange (Proxy @5)) - getConvIdsV2 alice paginationOpts !!! do + listConvIds alice paginationOpts !!! do const 200 === statusCode const (Right 2) === fmap length . decodeQualifiedConvIdList - getConvIdsV2 bob paginationOpts !!! do + listConvIds bob paginationOpts !!! do const 200 === statusCode const (Right 2) === fmap length . decodeQualifiedConvIdList -paginateConvIdsV2 :: TestM () -paginateConvIdsV2 = do +pageinateConvListIds :: TestM () +pageinateConvListIds = do [alice, bob, eve] <- randomUsers 3 connectUsers alice (singleton bob) connectUsers alice (singleton eve) @@ -1318,8 +1318,8 @@ paginateConvIdsV2 = do foldM_ (getChunkedConvs 16 alice) Nothing [15, 14 .. 0 :: Int] -- This test exists -paginateConvIdsV2PageEndingAtLocalsAndDomain :: TestM () -paginateConvIdsV2PageEndingAtLocalsAndDomain = do +pageinateConvListIdsPageEndingAtLocalsAndDomain :: TestM () +pageinateConvListIdsPageEndingAtLocalsAndDomain = do [alice, bob, eve] <- randomUsers 3 connectUsers alice (singleton bob) connectUsers alice (singleton eve) @@ -1377,7 +1377,7 @@ getChunkedConvs :: (Typeable a, FromJSON a) => Int32 -> UserId -> Maybe (Qualifi getChunkedConvs size alice start n = do let paginationOpts = GetPaginatedConversationIds start (unsafeRange size) print paginationOpts - resp <- getConvIdsV2 alice paginationOpts Public.GetPaginatedConversationIds -> TestM ResponseLBS -getConvIdsV2 u paginationOpts = do +listConvIds :: UserId -> Public.GetPaginatedConversationIds -> TestM ResponseLBS +listConvIds u paginationOpts = do g <- view tsGalley post $ g - . path "/conversations/ids/v2" + . path "/conversations/list-ids" . zUser u . json paginationOpts From 076cacd430ed3628fd73351e16cff2f46757c215 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 14:59:38 +0200 Subject: [PATCH 06/31] Ormolu --- services/galley/src/Galley/Data/Queries.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index 81a16a0c44c..c4c9e9ebeb1 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -316,7 +316,6 @@ selectUserRemoteConvsFromDomain = "select conv_remote_domain, conv_remote_id fro 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 = ?" - -- FUTUREWORK: actually make use of these cql statements. deleteUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () deleteUserRemoteConv = "delete from user_remote_conv where user = ? and conv_remote_domain = ? and conv_remote_id = ?" From 6cda74211a0c83c2884341bac5f18e349170d85f Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 15:13:05 +0200 Subject: [PATCH 07/31] Add haddocks for how the conversations are ordered --- services/galley/src/Galley/API/Query.hs | 10 ++++++++++ services/galley/src/Galley/Data.hs | 7 +++++++ 2 files changed, 17 insertions(+) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 3534842c600..8bc9e508c08 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -129,6 +129,16 @@ getConversationIds zusr start msize = do (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 orderd by their id +-- +-- - After local conversations, remote conversations are listed ordered +-- - lexicographically by their domain and then by their id. getConversationIdsV2 :: UserId -> Public.GetPaginatedConversationIds -> Galley (Public.ConversationList (Qualified ConvId)) getConversationIdsV2 zusr Public.GetPaginatedConversationIds {..} = do localDomain <- viewFederationDomain diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 644615184b3..5eebc5ffeab 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -552,6 +552,13 @@ 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 From 082f2e831a69eaaff10bb13e4f90ed04d6de0953 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 15:26:52 +0200 Subject: [PATCH 08/31] Rename functions for consistency --- libs/wire-api/src/Wire/API/Routes/Public/Galley.hs | 4 ++-- services/galley/src/Galley/API/Public.hs | 4 ++-- services/galley/src/Galley/API/Query.hs | 12 ++++++------ 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index 495dce2a36a..ecbb6587247 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -140,7 +140,7 @@ data Api routes = Api :> Capture "cnv" ConvId :> "roles" :> Get '[Servant.JSON] Public.ConversationRolesList, - getConversationIds :: + listConversationIdsUnqualified :: routes :- Summary "Get all local conversation IDs." -- FUTUREWORK: add bounds to swagger schema for Range @@ -162,7 +162,7 @@ data Api routes = Api "size" (Range 1 1000 Int32) :> Get '[Servant.JSON] (Public.ConversationList ConvId), - getConversationIdsV2 :: + listConversationIds :: routes :- Summary "Get all conversation IDs." :> ZUser diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 0203eae116c..1122a67c27e 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -80,8 +80,8 @@ servantSitemap = { GalleyAPI.getUnqualifiedConversation = Query.getUnqualifiedConversation, GalleyAPI.getConversation = Query.getConversation, GalleyAPI.getConversationRoles = Query.getConversationRoles, - GalleyAPI.getConversationIds = Query.getConversationIds, - GalleyAPI.getConversationIdsV2 = Query.getConversationIdsV2, + GalleyAPI.listConversationIdsUnqualified = Query.listConversationIdsUnqualified, + GalleyAPI.listConversationIds = Query.listConversationIds, GalleyAPI.getConversations = Query.getConversations, GalleyAPI.getConversationByReusableCode = Query.getConversationByReusableCode, GalleyAPI.listConversations = Query.listConversations, diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 8bc9e508c08..3170236898e 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -21,8 +21,8 @@ module Galley.API.Query getUnqualifiedConversation, getConversation, getConversationRoles, - getConversationIds, - getConversationIdsV2, + listConversationIdsUnqualified, + listConversationIds, getConversations, listConversations, iterateConversations, @@ -120,8 +120,8 @@ 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 $ @@ -139,8 +139,8 @@ getConversationIds zusr start msize = do -- -- - After local conversations, remote conversations are listed ordered -- - lexicographically by their domain and then by their id. -getConversationIdsV2 :: UserId -> Public.GetPaginatedConversationIds -> Galley (Public.ConversationList (Qualified ConvId)) -getConversationIdsV2 zusr Public.GetPaginatedConversationIds {..} = do +listConversationIds :: UserId -> Public.GetPaginatedConversationIds -> Galley (Public.ConversationList (Qualified ConvId)) +listConversationIds zusr Public.GetPaginatedConversationIds {..} = do localDomain <- viewFederationDomain let mStartDomain = qDomain <$> gpciStartingPoint case mStartDomain of From 5888386935ebfd88ab01e98f800c475e2f334c88 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 15:31:07 +0200 Subject: [PATCH 09/31] Fix comments --- services/galley/src/Galley/API/Query.hs | 2 +- services/galley/test/integration/API.hs | 30 ++----------------------- 2 files changed, 3 insertions(+), 29 deletions(-) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 3170236898e..c21a6866b2e 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -135,7 +135,7 @@ listConversationIdsUnqualified zusr start msize = do -- -- Pagination requires an order, in this case the order is defined as: -- --- - First all the local conversations are listed orderd by their id +-- - 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. diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 8cf388492a8..b871ae1e8db 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1328,8 +1328,8 @@ pageinateConvListIdsPageEndingAtLocalsAndDomain = do now <- liftIO getCurrentTime fedGalleyClient <- view tsFedGalleyClient - -- With page size 16, 29 group convs + 3 one-to-one convs, we get 32 convs. - -- The 2nd page should end here. + -- With page size 16, 29 group convs + 2 one-to-one convs + 1 self conv, we + -- get 32 convs. The 2nd page should end here. replicateM_ 29 $ postConv alice [bob, eve] (Just "gossip") [] Nothing Nothing !!! const 201 === statusCode @@ -1444,32 +1444,6 @@ listConvsPagingOk = do liftIO $ assertBool "getConvIds /= getConvs" (ids1 == ids3) return $ ids1 >>= listToMaybe . reverse --- listConvsRemotePagingOk :: TestM () --- listConvsRemotePagingOk = do --- [ally, bill, carl] <- randomUsers 3 --- connectUsers ally (list1 bill [carl]) --- replicateM_ 11 $ postConv ally [bill, carl] (Just "gossip") [] Nothing Nothing --- walk ally [3, 3, 3, 3, 2] -- 11 (group) + 2 (1:1) + 1 (self) --- walk bill [3, 3, 3, 3, 1] -- 11 (group) + 1 (1:1) + 1 (self) --- walk carl [3, 3, 3, 3, 1] -- 11 (group) + 1 (1:1) + 1 (self) --- where --- walk :: Foldable t => UserId -> t Int -> TestM () --- walk u = foldM_ (next u 3) Nothing --- next :: UserId -> Int32 -> Maybe ConvId -> Int -> TestM (Maybe ConvId) --- next u step start n = do --- -- FUTUREWORK: support an endpoint to get qualified conversation IDs --- -- (without all the conversation metadata) --- r1 <- getConvIds u (Right <$> start) (Just step) responseJsonUnsafe r1 --- liftIO $ assertEqual "unexpected length (getConvIds)" (Just n) (length <$> ids1) --- localDomain <- viewFederationDomain --- let requestBody = ListConversations Nothing (flip Qualified localDomain <$> start) (Just (unsafeRange step)) --- r2 <- listConvs u requestBody responseJsonUnsafe r2 --- liftIO $ assertEqual "unexpected length (getConvs)" (Just n) (length <$> ids3) --- liftIO $ assertBool "getConvIds /= getConvs" (ids1 == ids3) --- return $ ids1 >>= listToMaybe . reverse - postConvFailNotConnected :: TestM () postConvFailNotConnected = do alice <- randomUser From 93d84fb5ec78bed983fa3bdd962d715f682bc1cf Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 15:35:36 +0200 Subject: [PATCH 10/31] CHANGELOG --- CHANGELOG.md | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index e6318bb2b55..7a244234ffa 100644 --- a/CHANGELOG.md +++ b/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) From 02a8ca3d0f6145cec42b6035943b19130e7efeb6 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 3 Aug 2021 15:37:08 +0200 Subject: [PATCH 11/31] Mark `GET /conversations/ids` as deprecated --- libs/wire-api/src/Wire/API/Routes/Public/Galley.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index ecbb6587247..db63e2ac83d 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -142,7 +142,7 @@ data Api routes = Api :> Get '[Servant.JSON] Public.ConversationRolesList, listConversationIdsUnqualified :: routes - :- Summary "Get all local conversation IDs." + :- Summary "[deprecated] Get all local conversation IDs." -- FUTUREWORK: add bounds to swagger schema for Range :> ZUser :> "conversations" From 196733457f6330d8c48647a6a428e4c3ec4d37c4 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 4 Aug 2021 09:16:09 +0200 Subject: [PATCH 12/31] Fix typo --- services/galley/test/integration/API.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index b871ae1e8db..bf554c58169 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -119,8 +119,8 @@ tests s = test s "get conversation ids" getConvIdsOk, test s "get conversation ids v2" listConvIdsOk, test s "paginate through conversation ids" paginateConvIds, - test s "paginate through /converstaions/list-ids" pageinateConvListIds, - test s "paginate through /conversations/list-ids - page ending at locals and remote domain" pageinateConvListIdsPageEndingAtLocalsAndDomain, + test s "paginate through /converstaions/list-ids" paginateConvListIds, + test s "paginate through /conversations/list-ids - page ending at locals and remote domain" paginateConvListIdsPageEndingAtLocalsAndDomain, test s "fail to get >1000 conversation ids" getConvIdsFailMaxSize, test s "page through conversations" getConvsPagingOk, test s "page through list-conversations (local conversations only)" listConvsPagingOk, @@ -1266,8 +1266,8 @@ listConvIdsOk = do const 200 === statusCode const (Right 2) === fmap length . decodeQualifiedConvIdList -pageinateConvListIds :: TestM () -pageinateConvListIds = do +paginateConvListIds :: TestM () +paginateConvListIds = do [alice, bob, eve] <- randomUsers 3 connectUsers alice (singleton bob) connectUsers alice (singleton eve) @@ -1318,8 +1318,8 @@ pageinateConvListIds = do foldM_ (getChunkedConvs 16 alice) Nothing [15, 14 .. 0 :: Int] -- This test exists -pageinateConvListIdsPageEndingAtLocalsAndDomain :: TestM () -pageinateConvListIdsPageEndingAtLocalsAndDomain = do +paginateConvListIdsPageEndingAtLocalsAndDomain :: TestM () +paginateConvListIdsPageEndingAtLocalsAndDomain = do [alice, bob, eve] <- randomUsers 3 connectUsers alice (singleton bob) connectUsers alice (singleton eve) From 3d91255f06661bbf7becde218c08913ec3e7b8c9 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 4 Aug 2021 09:19:01 +0200 Subject: [PATCH 13/31] Remove redundant brackets --- services/galley/test/integration/API.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index bf554c58169..0e4ff6d9d6c 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -2156,12 +2156,12 @@ putMemberOk update = do Member { memId = bob, memService = Nothing, - memOtrMuted = Just True == (mupOtrMute update), + memOtrMuted = Just True == mupOtrMute update, memOtrMutedStatus = mupOtrMuteStatus update, memOtrMutedRef = mupOtrMuteRef update, - memOtrArchived = Just True == (mupOtrArchive update), + memOtrArchived = Just True == mupOtrArchive update, memOtrArchivedRef = mupOtrArchiveRef update, - memHidden = Just True == (mupHidden update), + memHidden = Just True == mupHidden update, memHiddenRef = mupHiddenRef update, memConvRoleName = fromMaybe roleNameWireAdmin (mupConvRoleName update) } From db741e747dad684a41882c08940722a13fc0dad6 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 4 Aug 2021 09:21:04 +0200 Subject: [PATCH 14/31] Reduce duplication --- services/galley/src/Galley/API/Query.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index c21a6866b2e..43c7b2ce842 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -144,9 +144,8 @@ 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 + Just x | x /= localDomain -> remotesOnly gpciStartingPoint $ fromRange gpciSize + _ -> localsAndRemotes localDomain (qUnqualified <$> gpciStartingPoint) gpciSize where localsAndRemotes :: Domain -> Maybe ConvId -> Range 1 1000 Int32 -> Galley (ConversationList (Qualified ConvId)) localsAndRemotes localDomain conv size = do From 064a3fceebde3ac0a2153f4497ed61c7397c79db Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 4 Aug 2021 13:33:18 +0200 Subject: [PATCH 15/31] Fix typo MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Marko Dimjašević --- services/galley/test/integration/API.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 0e4ff6d9d6c..3277e203925 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -119,7 +119,7 @@ tests s = test s "get conversation ids" getConvIdsOk, test s "get conversation ids v2" listConvIdsOk, test s "paginate through conversation ids" paginateConvIds, - test s "paginate through /converstaions/list-ids" paginateConvListIds, + test s "paginate through /conversations/list-ids" paginateConvListIds, test s "paginate through /conversations/list-ids - page ending at locals and remote domain" paginateConvListIdsPageEndingAtLocalsAndDomain, test s "fail to get >1000 conversation ids" getConvIdsFailMaxSize, test s "page through conversations" getConvsPagingOk, From 351919fb02133770c598cc5c345ae3ddb55c489c Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 4 Aug 2021 13:33:56 +0200 Subject: [PATCH 16/31] Optimize connections MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Marko Dimjašević --- services/galley/test/integration/API.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 3277e203925..f8554e6fd85 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1269,8 +1269,7 @@ listConvIdsOk = do paginateConvListIds :: TestM () paginateConvListIds = do [alice, bob, eve] <- randomUsers 3 - connectUsers alice (singleton bob) - connectUsers alice (singleton eve) + connectUsers alice (list1 bob [eve]) localDomain <- viewFederationDomain let qAlice = Qualified alice localDomain now <- liftIO getCurrentTime From 18ff99cff979427d33745b885e36058e06bcc7ae Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 4 Aug 2021 13:34:10 +0200 Subject: [PATCH 17/31] Optimize connections MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Marko Dimjašević --- services/galley/test/integration/API.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index f8554e6fd85..d51356971f7 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1320,8 +1320,7 @@ paginateConvListIds = do paginateConvListIdsPageEndingAtLocalsAndDomain :: TestM () paginateConvListIdsPageEndingAtLocalsAndDomain = do [alice, bob, eve] <- randomUsers 3 - connectUsers alice (singleton bob) - connectUsers alice (singleton eve) + connectUsers alice (list1 bob [eve]) localDomain <- viewFederationDomain let qAlice = Qualified alice localDomain now <- liftIO getCurrentTime From 5b769e0be5faf906f232b0bf27fdb93b50206f84 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 4 Aug 2021 13:35:48 +0200 Subject: [PATCH 18/31] Remove forgotten print MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Marko Dimjašević --- services/galley/test/integration/API.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index d51356971f7..73aa02c5ea1 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1374,7 +1374,6 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do getChunkedConvs :: (Typeable a, FromJSON a) => Int32 -> UserId -> Maybe (Qualified ConvId) -> Int -> TestM a getChunkedConvs size alice start n = do let paginationOpts = GetPaginatedConversationIds start (unsafeRange size) - print paginationOpts resp <- listConvIds alice paginationOpts Date: Mon, 9 Aug 2021 15:33:07 +0200 Subject: [PATCH 19/31] Use pagingState to page through qualified conv ids --- libs/types-common/src/Data/Json/Util.hs | 4 ++ libs/wire-api/src/Wire/API/Conversation.hs | 54 ++++++++++++++++- .../src/Wire/API/Routes/Public/Galley.hs | 2 +- services/galley/galley.cabal | 4 +- services/galley/package.yaml | 2 + services/galley/src/Galley/API/Query.hs | 45 ++++++++------ services/galley/src/Galley/Data.hs | 59 +++++++++++-------- services/galley/src/Galley/Data/Queries.hs | 8 +-- services/galley/test/integration/API.hs | 29 ++++----- 9 files changed, 140 insertions(+), 67 deletions(-) diff --git a/libs/types-common/src/Data/Json/Util.hs b/libs/types-common/src/Data/Json/Util.hs index 21e1e9b7091..bed1399f7fb 100644 --- a/libs/types-common/src/Data/Json/Util.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index e69170c853e..c5511de8983 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -27,6 +27,9 @@ module Wire.API.Conversation ConversationList (..), ListConversations (..), GetPaginatedConversationIds (..), + ConversationPagingState (..), + ConversationPagingTable (..), + ConvIdsPage (..), -- * Conversation properties Access (..), @@ -75,6 +78,7 @@ import Control.Lens (at, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as A import Data.Id +import Data.Json.Util (fromBase64Text, toBase64Text) import Data.List.NonEmpty (NonEmpty) import Data.List1 import Data.Misc @@ -256,8 +260,56 @@ 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 + +-- | TODO: Would be nice to not expose these details to clients +data ConversationPagingState = ConversationPagingState + { cpsTable :: ConversationPagingTable, + cpsPagingState :: Maybe ByteString + } + deriving (Show, Eq) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationPagingState + +instance ToSchema ConversationPagingState where + schema = + objectWithDocModifier + "ConversationPagingState" + (description ?~ "Clients should treat this object as opque and not try to parse it.") + $ ConversationPagingState + <$> cpsTable .= field "table" schema + <*> (fmap toBase64Text . cpsPagingState) .= optField "paging_state" Nothing (parsedText "PagingState" fromBase64Text) + +data ConversationPagingTable + = PagingLocals + | PagingRemotes + deriving (Show, Eq) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationPagingTable + +instance ToSchema ConversationPagingTable where + schema = + (S.schema . description ?~ "Used getting PagedConv") $ + enum @Text "ConversationTable" $ + mconcat + [ element "paging_locals" PagingLocals, + element "paging_remotes" PagingRemotes + ] + data GetPaginatedConversationIds = GetPaginatedConversationIds - { gpciStartingPoint :: Maybe (Qualified ConvId), + { gpciStartingPoint :: Maybe ConversationPagingState, gpciSize :: Range 1 1000 Int32 } deriving stock (Eq, Show, Generic) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index db63e2ac83d..af8023d84ed 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -169,7 +169,7 @@ data Api routes = Api :> "conversations" :> "list-ids" :> ReqBody '[Servant.JSON] Public.GetPaginatedConversationIds - :> Post '[Servant.JSON] (Public.ConversationList (Qualified ConvId)), + :> Post '[Servant.JSON] Public.ConvIdsPage, getConversations :: routes :- Summary "Get all *local* conversations." diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 54a109379f0..8e5a6da46d4 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 8728b07d9aff8cd747ea5ca33259f9168c966ae28ca76825e0a073e166d43213 +-- hash: b53cd7ea94dac7713998bbb4ce99fc7e3418caaf3fef49614484f9f72270014c name: galley version: 0.83.0 @@ -93,6 +93,8 @@ library , cassava >=0.5.2 , cereal >=0.4 , containers >=0.5 + , cql + , cql-io , currency-codes >=2.0 , data-default >=0.5 , enclosed-exceptions >=1.0 diff --git a/services/galley/package.yaml b/services/galley/package.yaml index 4b3430c0465..94c60972957 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -32,6 +32,8 @@ library: - bytestring >=0.9 - bytestring-conversion >=0.2 - cassandra-util >=0.16.2 + - cql + - cql-io - cassava >= 0.5.2 - cereal >=0.4 - containers >=0.5 diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 43c7b2ce842..5532a7cf2fa 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -34,6 +34,7 @@ module Galley.API.Query where import Control.Monad.Catch (throwM) +import qualified Data.ByteString.Lazy as LBS import Data.Code import Data.CommaSeparatedList import Data.Domain (Domain) @@ -41,6 +42,7 @@ import Data.Id as Id import Data.Proxy import Data.Qualified (Qualified (..), Remote, partitionRemote, partitionRemoteOrLocalIds', toRemote) import Data.Range +import qualified Database.CQL.Protocol as C import Galley.API.Error import qualified Galley.API.Mapping as Mapping import Galley.API.Util @@ -139,30 +141,37 @@ listConversationIdsUnqualified zusr start msize = do -- -- - 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 :: UserId -> Public.GetPaginatedConversationIds -> Galley Public.ConvIdsPage listConversationIds zusr Public.GetPaginatedConversationIds {..} = do localDomain <- viewFederationDomain - let mStartDomain = qDomain <$> gpciStartingPoint - case mStartDomain of - Just x | x /= localDomain -> remotesOnly gpciStartingPoint $ fromRange gpciSize - _ -> localsAndRemotes localDomain (qUnqualified <$> gpciStartingPoint) gpciSize + case gpciStartingPoint of + Just (Public.ConversationPagingState Public.PagingRemotes stateBS) -> remotesOnly (mkState <$> stateBS) (fromRange gpciSize) + _ -> localsAndRemotes localDomain (fmap mkState . Public.cpsPagingState =<< gpciStartingPoint) 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 + mkState :: ByteString -> C.PagingState + mkState = C.PagingState . LBS.fromStrict + + localsAndRemotes :: Domain -> Maybe C.PagingState -> Range 1 1000 Int32 -> Galley Public.ConvIdsPage + localsAndRemotes localDomain pagingState size = do + localPage <- pageToConvIdPage Public.PagingLocals . fmap (`Qualified` localDomain) <$> Data.conversationIdsPageFrom zusr pagingState size + let remainingSize = fromRange size - fromIntegral (length (Public.pageConvIds localPage)) + if Public.pageHasMore 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) + pure $ remotePage {Public.pageConvIds = Public.pageConvIds localPage <> Public.pageConvIds remotePage} + + remotesOnly :: Maybe C.PagingState -> Int32 -> Galley Public.ConvIdsPage + remotesOnly pagingState size = + pageToConvIdPage Public.PagingRemotes <$> Data.remoteConversationIdsFrom zusr pagingState size + + pageToConvIdPage :: Public.ConversationPagingTable -> Data.PageWithState (Qualified ConvId) -> Public.ConvIdsPage + pageToConvIdPage table Data.PageWithState {..} = + Public.ConvIdsPage + { pageConvIds = pwsResults, + pageHasMore = isJust pwsState, + pagePagingState = Public.ConversationPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) + } 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 diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 5eebc5ffeab..bc77e0e3c8d 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -20,6 +20,7 @@ module Galley.Data ( ResultSet, ResultSetType (..), + PageWithState (..), mkResultSet, resultSetType, resultSetResult, @@ -59,6 +60,7 @@ module Galley.Data acceptConnect, conversation, conversationIdsFrom, + conversationIdsPageFrom, conversationIdRowsForPagination, conversationIdsOf, conversationMeta, @@ -136,6 +138,10 @@ import Data.Tagged import Data.Time.Clock import qualified Data.UUID.Tagged as U import Data.UUID.V4 (nextRandom) +import Database.CQL.IO (RunQ) +import qualified Database.CQL.IO as C +import Database.CQL.Protocol (Tuple) +import qualified Database.CQL.Protocol as C import Galley.App import Galley.Data.Instances () import Galley.Data.LegalHold (isTeamLegalholdWhitelisted) @@ -552,29 +558,36 @@ 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)} +conversationIdsPageFrom :: + (MonadClient m, Log.MonadLogger m, MonadThrow m) => + UserId -> + Maybe C.PagingState -> + Range 1 1000 Int32 -> + m (PageWithState ConvId) +conversationIdsPageFrom usr pagingState (fromRange -> max) = + fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPWithState Quorum (Identity usr) max pagingState) + +paramsPWithState :: Consistency -> a -> Int32 -> Maybe C.PagingState -> QueryParams a +paramsPWithState c p n state = QueryParams c False p (Just n) state Nothing Nothing + +data PageWithState a = PageWithState + { pwsResults :: [a], + pwsState :: Maybe C.PagingState + } + deriving (Functor) + +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 {C.pageSize = C.pageSize p <|> Just 10000} + r <- C.runQ q p' + C.getResult r >>= \case + C.RowsResult m b -> + return $ PageWithState b (C.pagingState m) + _ -> throwM $ C.UnexpectedResponse (C.hrHost r) (C.hrResponse r) + +remoteConversationIdsFrom :: (MonadClient m, MonadLogger m) => UserId -> Maybe C.PagingState -> Int32 -> m (PageWithState (Qualified ConvId)) +remoteConversationIdsFrom usr pagingState max = + uncurry (flip Qualified) <$$> paginateWithState Cql.selectUserRemoteConvs (paramsPWithState Quorum (Identity usr) max pagingState) conversationIdRowsForPagination :: MonadClient m => UserId -> Maybe ConvId -> Range 1 1000 Int32 -> m (Page ConvId) conversationIdRowsForPagination usr start (fromRange -> max) = diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Data/Queries.hs index c4c9e9ebeb1..bd8cdd6277e 100644 --- a/services/galley/src/Galley/Data/Queries.hs +++ b/services/galley/src/Galley/Data/Queries.hs @@ -305,13 +305,7 @@ insertUserRemoteConv :: PrepQuery W (UserId, Domain, ConvId) () insertUserRemoteConv = "insert into user_remote_conv (user, conv_remote_domain, conv_remote_id) values (?, ?, ?)" 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" +selectUserRemoteConvs = "select conv_remote_domain, conv_remote_id from user_remote_conv where user = ?" 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 = ?" diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 73aa02c5ea1..c22f66048be 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1314,7 +1314,7 @@ paginateConvListIds = do -- 1 self conv + 2 convs with bob and eve + 197 local convs + 25 convs on -- chad.example.com + 31 on dee.example = 256 convs. Getting them 16 at a time -- should get all them in 16 times. - foldM_ (getChunkedConvs 16 alice) Nothing [15, 14 .. 0 :: Int] + foldM_ (getChunkedConvs 16 0 alice) Nothing [16, 15 .. 0 :: Int] -- This test exists paginateConvListIdsPageEndingAtLocalsAndDomain :: TestM () @@ -1333,7 +1333,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do !!! const 201 === statusCode -- We should be able to page through current state in 2 pages exactly - foldM_ (getChunkedConvs 16 alice) Nothing [1, 0 :: Int] + foldM_ (getChunkedConvs 16 0 alice) Nothing [2, 1, 0 :: Int] remoteChad <- randomId let chadDomain = Domain "chad.example.com" @@ -1369,26 +1369,23 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do } FederatedGalley.updateConversationMemberships fedGalleyClient cmu - foldM_ (getChunkedConvs 16 alice) Nothing [3, 2, 1, 0 :: Int] + foldM_ (getChunkedConvs 16 0 alice) Nothing [4, 3, 2, 1, 0 :: Int] -getChunkedConvs :: (Typeable a, FromJSON a) => Int32 -> UserId -> Maybe (Qualified ConvId) -> Int -> TestM a -getChunkedConvs size alice start n = do - let paginationOpts = GetPaginatedConversationIds start (unsafeRange size) +getChunkedConvs :: HasCallStack => Int32 -> Int -> UserId -> Maybe ConversationPagingState -> Int -> TestM (Maybe ConversationPagingState) +getChunkedConvs size lastSize alice pagingState n = do + let paginationOpts = GetPaginatedConversationIds pagingState (unsafeRange size) resp <- listConvIds alice paginationOpts show n <> " more gets to go") - (fromIntegral size) - (length (convList c)) + if n > 0 + then assertEqual ("Number of convs should match the requested size, " <> show n <> " more chunks to go") (fromIntegral size) (length (pageConvIds c)) + else assertEqual "Number of convs should match the last size, no more chunks to go" lastSize (length (pageConvIds c)) if n > 0 - then assertEqual ("hasMore should be True, " <> show n <> " more chunk(s) to go") True (convHasMore c) - else assertEqual "hasMore should be False, no more chunks to go" False (convHasMore c) + then assertEqual ("hasMore should be True, " <> show n <> " more chunk(s) to go") True (pageHasMore c) + else assertEqual "hasMore should be False, no more chunks to go" False (pageHasMore c) - return $ last (convList c) + return . Just $ pagePagingState c getConvsPagingOk :: TestM () getConvsPagingOk = do From 12852183880fc0f7fbcc06b3fb62db6b1bdbbe48 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 9 Aug 2021 16:10:19 +0200 Subject: [PATCH 20/31] Move code for paginateWithState to cassandra-util --- libs/cassandra-util/src/Cassandra.hs | 5 ++++ libs/cassandra-util/src/Cassandra/CQL.hs | 1 + libs/cassandra-util/src/Cassandra/Exec.hs | 35 +++++++++++++++++++++-- services/galley/galley.cabal | 4 +-- services/galley/package.yaml | 2 -- services/galley/src/Galley/API/Query.hs | 2 +- services/galley/src/Galley/Data.hs | 30 +++---------------- 7 files changed, 45 insertions(+), 34 deletions(-) diff --git a/libs/cassandra-util/src/Cassandra.hs b/libs/cassandra-util/src/Cassandra.hs index 31b9c4ed856..2b166cc9b4c 100644 --- a/libs/cassandra-util/src/Cassandra.hs +++ b/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, diff --git a/libs/cassandra-util/src/Cassandra/CQL.hs b/libs/cassandra-util/src/Cassandra/CQL.hs index 3680166d0da..058b6a5bd41 100644 --- a/libs/cassandra-util/src/Cassandra/CQL.hs +++ b/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, diff --git a/libs/cassandra-util/src/Cassandra/Exec.hs b/libs/cassandra-util/src/Cassandra/Exec.hs index bfe15af27f1..4b17f147dd0 100644 --- a/libs/cassandra-util/src/Cassandra/Exec.hs +++ b/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,11 +38,12 @@ 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 (RetrySettings, RunQ, runQ, defRetrySettings, eagerRetrySettings, getResult, ProtocolError (UnexpectedResponse), hrHost, hrResponse) -- 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 Imports hiding (init) +import qualified Database.CQL.Protocol as Protocol params :: Tuple a => Consistency -> a -> QueryParams a params c p = QueryParams c False p Nothing Nothing Nothing Nothing @@ -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 useless when 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 diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 8e5a6da46d4..54a109379f0 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: b53cd7ea94dac7713998bbb4ce99fc7e3418caaf3fef49614484f9f72270014c +-- hash: 8728b07d9aff8cd747ea5ca33259f9168c966ae28ca76825e0a073e166d43213 name: galley version: 0.83.0 @@ -93,8 +93,6 @@ library , cassava >=0.5.2 , cereal >=0.4 , containers >=0.5 - , cql - , cql-io , currency-codes >=2.0 , data-default >=0.5 , enclosed-exceptions >=1.0 diff --git a/services/galley/package.yaml b/services/galley/package.yaml index 94c60972957..4b3430c0465 100644 --- a/services/galley/package.yaml +++ b/services/galley/package.yaml @@ -32,8 +32,6 @@ library: - bytestring >=0.9 - bytestring-conversion >=0.2 - cassandra-util >=0.16.2 - - cql - - cql-io - cassava >= 0.5.2 - cereal >=0.4 - containers >=0.5 diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 5532a7cf2fa..124f5400e81 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -42,7 +42,6 @@ import Data.Id as Id import Data.Proxy import Data.Qualified (Qualified (..), Remote, partitionRemote, partitionRemoteOrLocalIds', toRemote) import Data.Range -import qualified Database.CQL.Protocol as C import Galley.API.Error import qualified Galley.API.Mapping as Mapping import Galley.API.Util @@ -65,6 +64,7 @@ import Wire.API.Federation.API.Galley (gcresConvs) import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Error import qualified Wire.API.Provider.Bot as Public +import qualified Cassandra as C getBotConversationH :: BotId ::: ConvId ::: JSON -> Galley Response getBotConversationH (zbot ::: zcnv ::: _) = do diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index bc77e0e3c8d..5eda4a5f4f4 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -138,10 +138,6 @@ import Data.Tagged import Data.Time.Clock import qualified Data.UUID.Tagged as U import Data.UUID.V4 (nextRandom) -import Database.CQL.IO (RunQ) -import qualified Database.CQL.IO as C -import Database.CQL.Protocol (Tuple) -import qualified Database.CQL.Protocol as C import Galley.App import Galley.Data.Instances () import Galley.Data.LegalHold (isTeamLegalholdWhitelisted) @@ -561,33 +557,15 @@ conversationIdsFrom usr start (fromRange -> max) = conversationIdsPageFrom :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => UserId -> - Maybe C.PagingState -> + Maybe PagingState -> Range 1 1000 Int32 -> m (PageWithState ConvId) conversationIdsPageFrom usr pagingState (fromRange -> max) = - fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPWithState Quorum (Identity usr) max pagingState) + fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState Quorum (Identity usr) max pagingState) -paramsPWithState :: Consistency -> a -> Int32 -> Maybe C.PagingState -> QueryParams a -paramsPWithState c p n state = QueryParams c False p (Just n) state Nothing Nothing - -data PageWithState a = PageWithState - { pwsResults :: [a], - pwsState :: Maybe C.PagingState - } - deriving (Functor) - -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 {C.pageSize = C.pageSize p <|> Just 10000} - r <- C.runQ q p' - C.getResult r >>= \case - C.RowsResult m b -> - return $ PageWithState b (C.pagingState m) - _ -> throwM $ C.UnexpectedResponse (C.hrHost r) (C.hrResponse r) - -remoteConversationIdsFrom :: (MonadClient m, MonadLogger m) => UserId -> Maybe C.PagingState -> Int32 -> m (PageWithState (Qualified ConvId)) +remoteConversationIdsFrom :: (MonadClient m, MonadLogger m) => UserId -> Maybe PagingState -> Int32 -> m (PageWithState (Qualified ConvId)) remoteConversationIdsFrom usr pagingState max = - uncurry (flip Qualified) <$$> paginateWithState Cql.selectUserRemoteConvs (paramsPWithState Quorum (Identity usr) max pagingState) + uncurry (flip Qualified) <$$> paginateWithState Cql.selectUserRemoteConvs (paramsPagingState Quorum (Identity usr) max pagingState) conversationIdRowsForPagination :: MonadClient m => UserId -> Maybe ConvId -> Range 1 1000 Int32 -> m (Page ConvId) conversationIdRowsForPagination usr start (fromRange -> max) = From 3a70ff29e474f0814cd04860fe784c4c24195ca6 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 9 Aug 2021 16:11:50 +0200 Subject: [PATCH 21/31] Ormolu --- libs/cassandra-util/src/Cassandra/Exec.hs | 6 +++--- services/galley/src/Galley/API/Query.hs | 2 +- services/galley/test/integration/API.hs | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/libs/cassandra-util/src/Cassandra/Exec.hs b/libs/cassandra-util/src/Cassandra/Exec.hs index 4b17f147dd0..141ab04ddcd 100644 --- a/libs/cassandra-util/src/Cassandra/Exec.hs +++ b/libs/cassandra-util/src/Cassandra/Exec.hs @@ -26,7 +26,7 @@ module Cassandra.Exec x1, syncCassandra, paginateC, - PageWithState(..), + PageWithState (..), paginateWithState, paramsPagingState, pwsHasMore, @@ -38,12 +38,12 @@ import Cassandra.CQL (Consistency, R) import Control.Monad.Catch import Data.Conduit -- We only use these locally. -import Database.CQL.IO (RetrySettings, RunQ, runQ, defRetrySettings, eagerRetrySettings, getResult, ProtocolError (UnexpectedResponse), hrHost, hrResponse) +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, pagingState) -import Imports hiding (init) import qualified Database.CQL.Protocol as Protocol +import Imports hiding (init) params :: Tuple a => Consistency -> a -> QueryParams a params c p = QueryParams c False p Nothing Nothing Nothing Nothing diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 124f5400e81..9fb7bda4336 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -33,6 +33,7 @@ module Galley.API.Query ) where +import qualified Cassandra as C import Control.Monad.Catch (throwM) import qualified Data.ByteString.Lazy as LBS import Data.Code @@ -64,7 +65,6 @@ import Wire.API.Federation.API.Galley (gcresConvs) import qualified Wire.API.Federation.API.Galley as FederatedGalley import Wire.API.Federation.Error import qualified Wire.API.Provider.Bot as Public -import qualified Cassandra as C getBotConversationH :: BotId ::: ConvId ::: JSON -> Galley Response getBotConversationH (zbot ::: zcnv ::: _) = do diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index c22f66048be..b90749db460 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1371,7 +1371,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do foldM_ (getChunkedConvs 16 0 alice) Nothing [4, 3, 2, 1, 0 :: Int] -getChunkedConvs :: HasCallStack => Int32 -> Int -> UserId -> Maybe ConversationPagingState -> Int -> TestM (Maybe ConversationPagingState) +getChunkedConvs :: HasCallStack => Int32 -> Int -> UserId -> Maybe ConversationPagingState -> Int -> TestM (Maybe ConversationPagingState) getChunkedConvs size lastSize alice pagingState n = do let paginationOpts = GetPaginatedConversationIds pagingState (unsafeRange size) resp <- listConvIds alice paginationOpts Date: Mon, 9 Aug 2021 16:31:13 +0200 Subject: [PATCH 22/31] Add some docs and rename some vars --- libs/wire-api/src/Wire/API/Conversation.hs | 10 +++++----- libs/wire-api/src/Wire/API/Routes/Public/Galley.hs | 1 + services/galley/src/Galley/API/Query.hs | 8 +++----- 3 files changed, 9 insertions(+), 10 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index c5511de8983..14074dfdd73 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -309,7 +309,7 @@ instance ToSchema ConversationPagingTable where ] data GetPaginatedConversationIds = GetPaginatedConversationIds - { gpciStartingPoint :: Maybe ConversationPagingState, + { gpciPagingState :: Maybe ConversationPagingState, gpciSize :: Range 1 1000 Int32 } deriving stock (Eq, Show, Generic) @@ -317,16 +317,16 @@ data GetPaginatedConversationIds = GetPaginatedConversationIds instance ToSchema GetPaginatedConversationIds where schema = - let addStartingPointDoc = + let addPagingStateDoc = 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." + ?~ "optional, when not 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 - <$> gpciStartingPoint .= optFieldWithDocModifier "starting_point" Nothing addStartingPointDoc schema + <$> gpciPagingState .= optFieldWithDocModifier "paging_state" Nothing addPagingStateDoc schema <*> gpciSize .= (fieldWithDocModifier "size" addSizeDoc schema <|> pure (toRange (Proxy @1000))) -- | Used on the POST /list-conversations endpoint diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index af8023d84ed..aa43801504d 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -165,6 +165,7 @@ data Api routes = Api listConversationIds :: routes :- Summary "Get all conversation IDs." + :> Description "To retrieve next page, a client must pass the paging_state returned by previous page." :> ZUser :> "conversations" :> "list-ids" diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 9fb7bda4336..e4563646226 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -131,9 +131,7 @@ listConversationIdsUnqualified zusr start msize = do (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. +-- | Lists conversation ids for the logged in user in a paginated way. -- -- Pagination requires an order, in this case the order is defined as: -- @@ -144,9 +142,9 @@ listConversationIdsUnqualified zusr start msize = do listConversationIds :: UserId -> Public.GetPaginatedConversationIds -> Galley Public.ConvIdsPage listConversationIds zusr Public.GetPaginatedConversationIds {..} = do localDomain <- viewFederationDomain - case gpciStartingPoint of + case gpciPagingState of Just (Public.ConversationPagingState Public.PagingRemotes stateBS) -> remotesOnly (mkState <$> stateBS) (fromRange gpciSize) - _ -> localsAndRemotes localDomain (fmap mkState . Public.cpsPagingState =<< gpciStartingPoint) gpciSize + _ -> localsAndRemotes localDomain (fmap mkState . Public.cpsPagingState =<< gpciPagingState) gpciSize where mkState :: ByteString -> C.PagingState mkState = C.PagingState . LBS.fromStrict From da349b6d47dfe96bf70c40f9c54436340eed2d8b Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Mon, 9 Aug 2021 17:06:08 +0200 Subject: [PATCH 23/31] Add haddocks for 'getChuckedConvs' --- services/galley/test/integration/API.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index b90749db460..4979273a62b 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1371,6 +1371,11 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do foldM_ (getChunkedConvs 16 0 alice) Nothing [4, 3, 2, 1, 0 :: Int] +-- | Gets chucked conversation ids given size of each chunk, size of the last +-- chunk, requesting user and @n@ which represents how many chunks are remaining +-- to go, when this is 0, it is assumed that this chunk is last and the response +-- must set @has_more@ to 'False' and the number of conv ids returned should +-- match @lastSize@. getChunkedConvs :: HasCallStack => Int32 -> Int -> UserId -> Maybe ConversationPagingState -> Int -> TestM (Maybe ConversationPagingState) getChunkedConvs size lastSize alice pagingState n = do let paginationOpts = GetPaginatedConversationIds pagingState (unsafeRange size) From aef140127a7ce9bad48a202c41d43468ec075a92 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 09:54:18 +0200 Subject: [PATCH 24/31] Galley/int: Use new type to decode qualified conv id list Co-authored-by: Paolo Capriotti --- services/galley/test/integration/API/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 8145d3d0f66..fd7a8cebb88 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -1296,7 +1296,7 @@ decodeConvIdList :: Response (Maybe Lazy.ByteString) -> [ConvId] decodeConvIdList = convList . responseJsonUnsafeWithMsg "conversation-ids" decodeQualifiedConvIdList :: Response (Maybe Lazy.ByteString) -> Either String [Qualified ConvId] -decodeQualifiedConvIdList = fmap convList . responseJsonEither +decodeQualifiedConvIdList = fmap pageConvIds . responseJsonEither zUser :: UserId -> Request -> Request zUser = header "Z-User" . toByteString' From c138c4a0d6bf33aa58603a137329798d99edc251 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 10:06:46 +0200 Subject: [PATCH 25/31] Fix typos, grammar mistakes, etc --- libs/cassandra-util/src/Cassandra/Exec.hs | 4 ++-- libs/wire-api/src/Wire/API/Conversation.hs | 8 ++++---- libs/wire-api/src/Wire/API/Routes/Public/Galley.hs | 2 +- services/galley/test/integration/API.hs | 7 +++++-- 4 files changed, 12 insertions(+), 9 deletions(-) diff --git a/libs/cassandra-util/src/Cassandra/Exec.hs b/libs/cassandra-util/src/Cassandra/Exec.hs index 141ab04ddcd..d39188bc039 100644 --- a/libs/cassandra-util/src/Cassandra/Exec.hs +++ b/libs/cassandra-util/src/Cassandra/Exec.hs @@ -114,8 +114,8 @@ data PageWithState a = PageWithState -- | 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 useless when schema of a --- table changes or when cassandra is upgraded. +-- 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} diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index 14074dfdd73..a581e1c05bb 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/libs/wire-api/src/Wire/API/Conversation.hs @@ -288,7 +288,7 @@ instance ToSchema ConversationPagingState where schema = objectWithDocModifier "ConversationPagingState" - (description ?~ "Clients should treat this object as opque and not try to parse it.") + (description ?~ "Clients should treat this object as opaque and not try to parse it.") $ ConversationPagingState <$> cpsTable .= field "table" schema <*> (fmap toBase64Text . cpsPagingState) .= optField "paging_state" Nothing (parsedText "PagingState" fromBase64Text) @@ -301,8 +301,8 @@ data ConversationPagingTable instance ToSchema ConversationPagingTable where schema = - (S.schema . description ?~ "Used getting PagedConv") $ - enum @Text "ConversationTable" $ + (S.schema . description ?~ "Used for getting ConvIdsPage") $ + enum @Text "ConversationPagingTable" $ mconcat [ element "paging_locals" PagingLocals, element "paging_remotes" PagingRemotes @@ -319,7 +319,7 @@ instance ToSchema GetPaginatedConversationIds where schema = let addPagingStateDoc = description - ?~ "optional, when not first page of the conversation ids will be returned.\ + ?~ "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 diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs index aa43801504d..556ac122586 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley.hs @@ -165,7 +165,7 @@ data Api routes = Api listConversationIds :: routes :- Summary "Get all conversation IDs." - :> Description "To retrieve next page, a client must pass the paging_state returned by previous page." + :> Description "To retrieve the next page, a client must pass the paging_state returned by the previous page." :> ZUser :> "conversations" :> "list-ids" diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 4979273a62b..28b6471eb95 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -1316,7 +1316,10 @@ paginateConvListIds = do -- should get all them in 16 times. foldM_ (getChunkedConvs 16 0 alice) Nothing [16, 15 .. 0 :: Int] --- This test exists +-- This test ensures to setup conversations so that a page would end exactly +-- when local convs are exhausted and then exactly when another remote domain's +-- convs are exhausted. As the local convs and remote convs are stored in two +-- different tables, this is an important edge case to test. paginateConvListIdsPageEndingAtLocalsAndDomain :: TestM () paginateConvListIdsPageEndingAtLocalsAndDomain = do [alice, bob, eve] <- randomUsers 3 @@ -1371,7 +1374,7 @@ paginateConvListIdsPageEndingAtLocalsAndDomain = do foldM_ (getChunkedConvs 16 0 alice) Nothing [4, 3, 2, 1, 0 :: Int] --- | Gets chucked conversation ids given size of each chunk, size of the last +-- | Gets chunked conversation ids given size of each chunk, size of the last -- chunk, requesting user and @n@ which represents how many chunks are remaining -- to go, when this is 0, it is assumed that this chunk is last and the response -- must set @has_more@ to 'False' and the number of conv ids returned should From 4cb8ccae76007751c1fbfb12d2119c8821976f77 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 10:44:18 +0200 Subject: [PATCH 26/31] Make ConversationPagingState Opaque --- libs/wire-api/src/Wire/API/Conversation.hs | 51 ++++++++++++++-------- 1 file changed, 32 insertions(+), 19 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Conversation.hs b/libs/wire-api/src/Wire/API/Conversation.hs index a581e1c05bb..55e9c50fa72 100644 --- a/libs/wire-api/src/Wire/API/Conversation.hs +++ b/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,8 +19,8 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . --- 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 (..), @@ -77,6 +78,8 @@ 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) @@ -276,7 +279,6 @@ instance ToSchema ConvIdsPage where <*> pageHasMore .= field "has_more" schema <*> pagePagingState .= field "paging_state" schema --- | TODO: Would be nice to not expose these details to clients data ConversationPagingState = ConversationPagingState { cpsTable :: ConversationPagingTable, cpsPagingState :: Maybe ByteString @@ -286,27 +288,38 @@ data ConversationPagingState = ConversationPagingState instance ToSchema ConversationPagingState where schema = - objectWithDocModifier - "ConversationPagingState" - (description ?~ "Clients should treat this object as opaque and not try to parse it.") - $ ConversationPagingState - <$> cpsTable .= field "table" schema - <*> (fmap toBase64Text . cpsPagingState) .= optField "paging_state" Nothing (parsedText "PagingState" fromBase64Text) + (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) - deriving (FromJSON, ToJSON, S.ToSchema) via Schema ConversationPagingTable - -instance ToSchema ConversationPagingTable where - schema = - (S.schema . description ?~ "Used for getting ConvIdsPage") $ - enum @Text "ConversationPagingTable" $ - mconcat - [ element "paging_locals" PagingLocals, - element "paging_remotes" PagingRemotes - ] data GetPaginatedConversationIds = GetPaginatedConversationIds { gpciPagingState :: Maybe ConversationPagingState, From 007baff8d2c8f50deb357fea651d1ca27b2a472d Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 11:12:50 +0200 Subject: [PATCH 27/31] Add golden tests --- .../test/golden/testObject_ConvIdsPage_1.json | 5 +++++ .../test/golden/testObject_ConvIdsPage_2.json | 10 ++++++++++ .../testObject_ConversationPagingState_1.json | 1 + .../testObject_ConversationPagingState_2.json | 1 + .../testObject_ConversationPagingState_3.json | 1 + .../testObject_ConversationPagingState_4.json | 1 + ...tObject_GetPaginatedConversationIds_1.json | 3 +++ ...tObject_GetPaginatedConversationIds_2.json | 4 ++++ .../test/unit/Test/Wire/API/Golden/Manual.hs | 20 +++++++++++++++++++ .../Wire/API/Golden/Manual/ConvIdsPage.hs | 15 ++++++++++++++ .../Golden/Manual/ConversationPagingState.hs | 17 ++++++++++++++++ .../Manual/GetPaginatedConversationIds.hs | 12 +++++++++++ libs/wire-api/wire-api.cabal | 5 ++++- 13 files changed, 94 insertions(+), 1 deletion(-) create mode 100644 libs/wire-api/test/golden/testObject_ConvIdsPage_1.json create mode 100644 libs/wire-api/test/golden/testObject_ConvIdsPage_2.json create mode 100644 libs/wire-api/test/golden/testObject_ConversationPagingState_1.json create mode 100644 libs/wire-api/test/golden/testObject_ConversationPagingState_2.json create mode 100644 libs/wire-api/test/golden/testObject_ConversationPagingState_3.json create mode 100644 libs/wire-api/test/golden/testObject_ConversationPagingState_4.json create mode 100644 libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_1.json create mode 100644 libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_2.json create mode 100644 libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConvIdsPage.hs create mode 100644 libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs create mode 100644 libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs diff --git a/libs/wire-api/test/golden/testObject_ConvIdsPage_1.json b/libs/wire-api/test/golden/testObject_ConvIdsPage_1.json new file mode 100644 index 00000000000..e56981dcc2d --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ConvIdsPage_1.json @@ -0,0 +1,5 @@ +{ + "has_more": false, + "paging_state": "AA==", + "qualified_conversations": [] +} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_ConvIdsPage_2.json b/libs/wire-api/test/golden/testObject_ConvIdsPage_2.json new file mode 100644 index 00000000000..54491bffe9d --- /dev/null +++ b/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" + } + ] +} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_ConversationPagingState_1.json b/libs/wire-api/test/golden/testObject_ConversationPagingState_1.json new file mode 100644 index 00000000000..12ccb495bea --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ConversationPagingState_1.json @@ -0,0 +1 @@ +"AA==" \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_ConversationPagingState_2.json b/libs/wire-api/test/golden/testObject_ConversationPagingState_2.json new file mode 100644 index 00000000000..400bef583ca --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ConversationPagingState_2.json @@ -0,0 +1 @@ +"AAABWGN9WA==" \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_ConversationPagingState_3.json b/libs/wire-api/test/golden/testObject_ConversationPagingState_3.json new file mode 100644 index 00000000000..3ca82884d86 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ConversationPagingState_3.json @@ -0,0 +1 @@ +"AQ==" \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_ConversationPagingState_4.json b/libs/wire-api/test/golden/testObject_ConversationPagingState_4.json new file mode 100644 index 00000000000..f04aaae71e3 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_ConversationPagingState_4.json @@ -0,0 +1 @@ +"AVgMFw==" \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_1.json b/libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_1.json new file mode 100644 index 00000000000..57dfcf1da08 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_1.json @@ -0,0 +1,3 @@ +{ + "size": 50 +} \ No newline at end of file diff --git a/libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_2.json b/libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_2.json new file mode 100644 index 00000000000..5de0d4bea98 --- /dev/null +++ b/libs/wire-api/test/golden/testObject_GetPaginatedConversationIds_2.json @@ -0,0 +1,4 @@ +{ + "size": 1000, + "paging_state": "AA==" +} \ No newline at end of file diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs index 8ba523d2d02..bd7fd0d8b03 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual.hs +++ b/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")], diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConvIdsPage.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConvIdsPage.hs new file mode 100644 index 00000000000..e81ba688147 --- /dev/null +++ b/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 diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs new file mode 100644 index 00000000000..a9f4fb44b66 --- /dev/null +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs @@ -0,0 +1,17 @@ +module Test.Wire.API.Golden.Manual.ConversationPagingState where + +import Imports +import Wire.API.Conversation +import qualified Data.ByteString as BS + +testObject_ConversationPagingState_1 :: ConversationPagingState +testObject_ConversationPagingState_1 = ConversationPagingState PagingLocals Nothing + +testObject_ConversationPagingState_2 :: ConversationPagingState +testObject_ConversationPagingState_2 = ConversationPagingState PagingLocals (Just (BS.pack [0,1,88,99,125,88])) + +testObject_ConversationPagingState_3 :: ConversationPagingState +testObject_ConversationPagingState_3 = ConversationPagingState PagingRemotes Nothing + +testObject_ConversationPagingState_4 :: ConversationPagingState +testObject_ConversationPagingState_4 = ConversationPagingState PagingRemotes (Just (BS.pack [88, 12,23])) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs new file mode 100644 index 00000000000..969dea84d5c --- /dev/null +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs @@ -0,0 +1,12 @@ +module Test.Wire.API.Golden.Manual.GetPaginatedConversationIds where + +import Imports +import Wire.API.Conversation +import Data.Range +import Data.Proxy + +testObject_GetPaginatedConversationIds_1 :: GetPaginatedConversationIds +testObject_GetPaginatedConversationIds_1 = GetPaginatedConversationIds Nothing (toRange (Proxy @50)) + +testObject_GetPaginatedConversationIds_2 :: GetPaginatedConversationIds +testObject_GetPaginatedConversationIds_2 = GetPaginatedConversationIds (Just $ ConversationPagingState PagingLocals Nothing) (toRange (Proxy @1000)) diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal index 534853d76f6..214d42c271e 100644 --- a/libs/wire-api/wire-api.cabal +++ b/libs/wire-api/wire-api.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: 51eb96bf37999a61021ffce3cf4fdb0ac87752f9fe570564d30a06530ec1e844 +-- hash: 8dd9d13d48a5f49187dd78a33f0af43e7dbd0265bd1bca52345b1a5ad445028e name: wire-api version: 0.1.0 @@ -398,7 +398,10 @@ test-suite wire-api-tests Test.Wire.API.Golden.Manual.ClientCapability Test.Wire.API.Golden.Manual.ClientCapabilityList Test.Wire.API.Golden.Manual.ConversationCoverView + Test.Wire.API.Golden.Manual.ConversationPagingState + Test.Wire.API.Golden.Manual.ConvIdsPage Test.Wire.API.Golden.Manual.FeatureConfigEvent + Test.Wire.API.Golden.Manual.GetPaginatedConversationIds Test.Wire.API.Golden.Manual.ListConversations Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap Test.Wire.API.Golden.Manual.UserClientPrekeyMap From 0810f891bebc1a8c51d714ef6a0dea861d05c426 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 11:20:37 +0200 Subject: [PATCH 28/31] Ormolu --- .../Test/Wire/API/Golden/Manual/ConversationPagingState.hs | 6 +++--- .../Wire/API/Golden/Manual/GetPaginatedConversationIds.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs index a9f4fb44b66..bcf75ee423d 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/ConversationPagingState.hs @@ -1,17 +1,17 @@ module Test.Wire.API.Golden.Manual.ConversationPagingState where +import qualified Data.ByteString as BS import Imports import Wire.API.Conversation -import qualified Data.ByteString as BS testObject_ConversationPagingState_1 :: ConversationPagingState testObject_ConversationPagingState_1 = ConversationPagingState PagingLocals Nothing testObject_ConversationPagingState_2 :: ConversationPagingState -testObject_ConversationPagingState_2 = ConversationPagingState PagingLocals (Just (BS.pack [0,1,88,99,125,88])) +testObject_ConversationPagingState_2 = ConversationPagingState PagingLocals (Just (BS.pack [0, 1, 88, 99, 125, 88])) testObject_ConversationPagingState_3 :: ConversationPagingState testObject_ConversationPagingState_3 = ConversationPagingState PagingRemotes Nothing testObject_ConversationPagingState_4 :: ConversationPagingState -testObject_ConversationPagingState_4 = ConversationPagingState PagingRemotes (Just (BS.pack [88, 12,23])) +testObject_ConversationPagingState_4 = ConversationPagingState PagingRemotes (Just (BS.pack [88, 12, 23])) diff --git a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs index 969dea84d5c..5848a8b0fb2 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Golden/Manual/GetPaginatedConversationIds.hs @@ -1,9 +1,9 @@ module Test.Wire.API.Golden.Manual.GetPaginatedConversationIds where +import Data.Proxy +import Data.Range import Imports import Wire.API.Conversation -import Data.Range -import Data.Proxy testObject_GetPaginatedConversationIds_1 :: GetPaginatedConversationIds testObject_GetPaginatedConversationIds_1 = GetPaginatedConversationIds Nothing (toRange (Proxy @50)) From 8ca1d9b47c0ee6bd3de2e332e0f9272b996b0614 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 11:32:04 +0200 Subject: [PATCH 29/31] Better function names --- services/galley/src/Galley/API/Public.hs | 4 ++-- services/galley/src/Galley/API/Query.hs | 16 ++++++++-------- services/galley/src/Galley/Data.hs | 13 +++++++------ 3 files changed, 17 insertions(+), 16 deletions(-) diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 1122a67c27e..b256288b0ac 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -80,8 +80,8 @@ servantSitemap = { GalleyAPI.getUnqualifiedConversation = Query.getUnqualifiedConversation, GalleyAPI.getConversation = Query.getConversation, GalleyAPI.getConversationRoles = Query.getConversationRoles, - GalleyAPI.listConversationIdsUnqualified = Query.listConversationIdsUnqualified, - GalleyAPI.listConversationIds = Query.listConversationIds, + GalleyAPI.listConversationIdsUnqualified = Query.conversationIdsPageFromUnqualified, + GalleyAPI.listConversationIds = Query.conversationIdsPageFrom, GalleyAPI.getConversations = Query.getConversations, GalleyAPI.getConversationByReusableCode = Query.getConversationByReusableCode, GalleyAPI.listConversations = Query.listConversations, diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index e4563646226..c883f4b6d1f 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -21,8 +21,8 @@ module Galley.API.Query getUnqualifiedConversation, getConversation, getConversationRoles, - listConversationIdsUnqualified, - listConversationIds, + conversationIdsPageFromUnqualified, + conversationIdsPageFrom, getConversations, listConversations, iterateConversations, @@ -122,8 +122,8 @@ getConversationRoles zusr cnv = do -- be merged with the team roles (if they exist) pure $ Public.ConversationRolesList wireConvRoles -listConversationIdsUnqualified :: UserId -> Maybe ConvId -> Maybe (Range 1 1000 Int32) -> Galley (Public.ConversationList ConvId) -listConversationIdsUnqualified zusr start msize = do +conversationIdsPageFromUnqualified :: UserId -> Maybe ConvId -> Maybe (Range 1 1000 Int32) -> Galley (Public.ConversationList ConvId) +conversationIdsPageFromUnqualified zusr start msize = do let size = fromMaybe (toRange (Proxy @1000)) msize ids <- Data.conversationIdsFrom zusr start size pure $ @@ -139,8 +139,8 @@ listConversationIdsUnqualified zusr start msize = do -- -- - After local conversations, remote conversations are listed ordered -- - lexicographically by their domain and then by their id. -listConversationIds :: UserId -> Public.GetPaginatedConversationIds -> Galley Public.ConvIdsPage -listConversationIds zusr Public.GetPaginatedConversationIds {..} = do +conversationIdsPageFrom :: UserId -> Public.GetPaginatedConversationIds -> Galley Public.ConvIdsPage +conversationIdsPageFrom zusr Public.GetPaginatedConversationIds {..} = do localDomain <- viewFederationDomain case gpciPagingState of Just (Public.ConversationPagingState Public.PagingRemotes stateBS) -> remotesOnly (mkState <$> stateBS) (fromRange gpciSize) @@ -151,7 +151,7 @@ listConversationIds zusr Public.GetPaginatedConversationIds {..} = do localsAndRemotes :: Domain -> Maybe C.PagingState -> Range 1 1000 Int32 -> Galley Public.ConvIdsPage localsAndRemotes localDomain pagingState size = do - localPage <- pageToConvIdPage Public.PagingLocals . fmap (`Qualified` localDomain) <$> Data.conversationIdsPageFrom zusr pagingState size + localPage <- pageToConvIdPage Public.PagingLocals . fmap (`Qualified` localDomain) <$> Data.localConversationIdsPageFrom zusr pagingState size let remainingSize = fromRange size - fromIntegral (length (Public.pageConvIds localPage)) if Public.pageHasMore localPage then pure localPage @@ -161,7 +161,7 @@ listConversationIds zusr Public.GetPaginatedConversationIds {..} = do remotesOnly :: Maybe C.PagingState -> Int32 -> Galley Public.ConvIdsPage remotesOnly pagingState size = - pageToConvIdPage Public.PagingRemotes <$> Data.remoteConversationIdsFrom zusr pagingState size + pageToConvIdPage Public.PagingRemotes <$> Data.remoteConversationIdsPageFrom zusr pagingState size pageToConvIdPage :: Public.ConversationPagingTable -> Data.PageWithState (Qualified ConvId) -> Public.ConvIdsPage pageToConvIdPage table Data.PageWithState {..} = diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index 5eda4a5f4f4..f531fdaf621 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -60,7 +60,7 @@ module Galley.Data acceptConnect, conversation, conversationIdsFrom, - conversationIdsPageFrom, + localConversationIdsPageFrom, conversationIdRowsForPagination, conversationIdsOf, conversationMeta, @@ -77,7 +77,7 @@ module Galley.Data updateConversationMessageTimer, deleteConversation, lookupReceiptMode, - remoteConversationIdsFrom, + remoteConversationIdsPageFrom, -- * Conversation Members addMember, @@ -541,6 +541,7 @@ conversationMeta conv = where toConvMeta (t, c, a, r, n, i, _, mt, rm) = ConversationMeta conv t c (defAccess t a) (maybeRole t r) n i mt rm +-- | Deprecated, use 'localConversationIdsPageFrom' conversationIdsFrom :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => UserId -> @@ -554,17 +555,17 @@ conversationIdsFrom usr start (fromRange -> max) = where strip p = p {result = take (fromIntegral max) (result p)} -conversationIdsPageFrom :: +localConversationIdsPageFrom :: (MonadClient m, Log.MonadLogger m, MonadThrow m) => UserId -> Maybe PagingState -> Range 1 1000 Int32 -> m (PageWithState ConvId) -conversationIdsPageFrom usr pagingState (fromRange -> max) = +localConversationIdsPageFrom usr pagingState (fromRange -> max) = fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState Quorum (Identity usr) max pagingState) -remoteConversationIdsFrom :: (MonadClient m, MonadLogger m) => UserId -> Maybe PagingState -> Int32 -> m (PageWithState (Qualified ConvId)) -remoteConversationIdsFrom usr pagingState max = +remoteConversationIdsPageFrom :: (MonadClient m, MonadLogger m) => UserId -> Maybe PagingState -> Int32 -> m (PageWithState (Qualified ConvId)) +remoteConversationIdsPageFrom usr pagingState max = uncurry (flip Qualified) <$$> paginateWithState Cql.selectUserRemoteConvs (paramsPagingState Quorum (Identity usr) max pagingState) conversationIdRowsForPagination :: MonadClient m => UserId -> Maybe ConvId -> Range 1 1000 Int32 -> m (Page ConvId) From b66a2760c4399732d9e5b8daa5e8fdfd0f4af222 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 14:46:44 +0200 Subject: [PATCH 30/31] Optimize number of DB calls --- services/galley/src/Galley/API/Query.hs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index c883f4b6d1f..d401ed47306 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -153,8 +153,8 @@ conversationIdsPageFrom zusr Public.GetPaginatedConversationIds {..} = do localsAndRemotes localDomain pagingState size = do localPage <- pageToConvIdPage Public.PagingLocals . fmap (`Qualified` localDomain) <$> Data.localConversationIdsPageFrom zusr pagingState size let remainingSize = fromRange size - fromIntegral (length (Public.pageConvIds localPage)) - if Public.pageHasMore localPage - then pure localPage + if Public.pageHasMore localPage || remainingSize <= 0 + then pure localPage {Public.pageHasMore = True} -- We haven't check the remotes yet, so has_more must always be True here. else do remotePage <- remotesOnly Nothing remainingSize pure $ remotePage {Public.pageConvIds = Public.pageConvIds localPage <> Public.pageConvIds remotePage} @@ -164,11 +164,15 @@ conversationIdsPageFrom zusr Public.GetPaginatedConversationIds {..} = do pageToConvIdPage Public.PagingRemotes <$> Data.remoteConversationIdsPageFrom zusr pagingState size pageToConvIdPage :: Public.ConversationPagingTable -> Data.PageWithState (Qualified ConvId) -> Public.ConvIdsPage - pageToConvIdPage table Data.PageWithState {..} = + pageToConvIdPage table page@Data.PageWithState {..} = Public.ConvIdsPage { pageConvIds = pwsResults, - pageHasMore = isJust pwsState, - pagePagingState = Public.ConversationPagingState table (LBS.toStrict . C.unPagingState <$> pwsState) + pageHasMore = C.pwsHasMore page, + pagePagingState = + Public.ConversationPagingState + { cpsTable = table, + cpsPagingState = LBS.toStrict . C.unPagingState <$> pwsState + } } getConversations :: UserId -> Maybe (Range 1 32 (CommaSeparatedList ConvId)) -> Maybe ConvId -> Maybe (Range 1 500 Int32) -> Galley (Public.ConversationList Public.Conversation) From a5f79bd1b9b36d10d4c574d9bbb431b174c13191 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 10 Aug 2021 14:51:14 +0200 Subject: [PATCH 31/31] Optimize type class constraints --- services/galley/src/Galley/Data.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index f531fdaf621..2e14434e5d1 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -543,7 +543,7 @@ conversationMeta conv = -- | Deprecated, use 'localConversationIdsPageFrom' conversationIdsFrom :: - (MonadClient m, Log.MonadLogger m, MonadThrow m) => + (MonadClient m) => UserId -> Maybe ConvId -> Range 1 1000 Int32 -> @@ -556,7 +556,7 @@ conversationIdsFrom usr start (fromRange -> max) = strip p = p {result = take (fromIntegral max) (result p)} localConversationIdsPageFrom :: - (MonadClient m, Log.MonadLogger m, MonadThrow m) => + (MonadClient m) => UserId -> Maybe PagingState -> Range 1 1000 Int32 -> @@ -564,7 +564,7 @@ localConversationIdsPageFrom :: localConversationIdsPageFrom usr pagingState (fromRange -> max) = fmap runIdentity <$> paginateWithState Cql.selectUserConvs (paramsPagingState Quorum (Identity usr) max pagingState) -remoteConversationIdsPageFrom :: (MonadClient m, MonadLogger m) => UserId -> Maybe PagingState -> Int32 -> m (PageWithState (Qualified ConvId)) +remoteConversationIdsPageFrom :: (MonadClient m) => UserId -> Maybe PagingState -> Int32 -> m (PageWithState (Qualified ConvId)) remoteConversationIdsPageFrom usr pagingState max = uncurry (flip Qualified) <$$> paginateWithState Cql.selectUserRemoteConvs (paramsPagingState Quorum (Identity usr) max pagingState)