diff --git a/changelog.d/5-internal/generalized-paging b/changelog.d/5-internal/generalized-paging new file mode 100644 index 00000000000..e8d064927e3 --- /dev/null +++ b/changelog.d/5-internal/generalized-paging @@ -0,0 +1 @@ +Move Paging effect from galley into polysemy-wire-zoo diff --git a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal index 9c992d764b2..9362cb0a7ad 100644 --- a/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal +++ b/libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal @@ -21,6 +21,8 @@ library Wire.Sem.Now.Input Wire.Sem.Now.IO Wire.Sem.Now.Spec + Wire.Sem.Paging + Wire.Sem.Paging.Cassandra Wire.Sem.Random Wire.Sem.Random.IO @@ -74,6 +76,7 @@ library base >=4.6 && <5.0 , HsOpenSSL , hspec + , cassandra-util , imports , polysemy , polysemy-check @@ -84,5 +87,6 @@ library , tinylog , types-common , uuid + , wire-api default-language: Haskell2010 diff --git a/services/galley/src/Galley/Effects/Paging.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging.hs similarity index 98% rename from services/galley/src/Galley/Effects/Paging.hs rename to libs/polysemy-wire-zoo/src/Wire/Sem/Paging.hs index 8df8e9393af..2636eae7a96 100644 --- a/services/galley/src/Galley/Effects/Paging.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging.hs @@ -15,7 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Effects.Paging +module Wire.Sem.Paging ( -- * General paging types Page, PagingState, diff --git a/services/galley/src/Galley/Cassandra/Paging.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs similarity index 72% rename from services/galley/src/Galley/Cassandra/Paging.hs rename to libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs index 139a42df587..ec3efee4fdb 100644 --- a/services/galley/src/Galley/Cassandra/Paging.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs @@ -15,7 +15,7 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Galley.Cassandra.Paging +module Wire.Sem.Paging.Cassandra ( CassandraPaging, LegacyPaging, InternalPaging, @@ -23,9 +23,8 @@ module Galley.Cassandra.Paging InternalPagingState (..), mkInternalPage, ipNext, - - -- * Re-exports ResultSet, + mkResultSet, resultSetResult, resultSetType, ResultSetType (..), @@ -36,10 +35,9 @@ import Cassandra import Data.Id import Data.Qualified import Data.Range -import Galley.Cassandra.ResultSet -import qualified Galley.Effects.Paging as E import Imports import Wire.API.Team.Member (HardTruncationLimit, TeamMember) +import qualified Wire.Sem.Paging as E -- | This paging system uses Cassandra's 'PagingState' to keep track of state, -- and does not rely on ordering. This is the preferred way of paging across @@ -101,3 +99,33 @@ instance E.Paging InternalPaging where pageItems (InternalPage (_, _, items)) = items pageHasMore (InternalPage (p, _, _)) = hasMore p pageState (InternalPage (p, f, _)) = InternalPagingState (p, f) + +-- We use this newtype to highlight the fact that the 'Page' wrapped in here +-- can not reliably used for paging. +-- +-- The reason for this is that Cassandra returns 'hasMore' as true if the +-- page size requested is equal to result size. To work around this we +-- actually request for one additional element and drop the last value if +-- necessary. This means however that 'nextPage' does not work properly as +-- we would miss a value on every page size. +-- Thus, and since we don't want to expose the ResultSet constructor +-- because it gives access to `nextPage`, we give accessors to the results +-- and a more typed `hasMore` (ResultSetComplete | ResultSetTruncated) +data ResultSet a = ResultSet + { resultSetResult :: [a], + resultSetType :: ResultSetType + } + deriving stock (Show, Functor, Foldable, Traversable) + +-- | A more descriptive type than using a simple bool to represent `hasMore` +data ResultSetType + = ResultSetComplete + | ResultSetTruncated + deriving stock (Eq, Show) + +mkResultSet :: Page a -> ResultSet a +mkResultSet page = ResultSet (result page) typ + where + typ + | hasMore page = ResultSetTruncated + | otherwise = ResultSetComplete diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 00b65e9cece..76c6ec52e00 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -58,10 +58,8 @@ library Galley.Cassandra.CustomBackend Galley.Cassandra.Instances Galley.Cassandra.LegalHold - Galley.Cassandra.Paging Galley.Cassandra.Proposal Galley.Cassandra.Queries - Galley.Cassandra.ResultSet Galley.Cassandra.SearchVisibility Galley.Cassandra.Services Galley.Cassandra.Store @@ -88,7 +86,6 @@ library Galley.Effects.LegalHoldStore Galley.Effects.ListItems Galley.Effects.MemberStore - Galley.Effects.Paging Galley.Effects.ProposalStore Galley.Effects.Queue Galley.Effects.RemoteConversationListStore diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 3257f1f9d1b..04497a56828 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -49,7 +49,6 @@ import Galley.API.Teams.Features import qualified Galley.API.Update as Update import Galley.API.Util import Galley.App -import Galley.Cassandra.Paging import Galley.Cassandra.TeamFeatures import qualified Galley.Data.Conversation as Data import Galley.Effects @@ -59,7 +58,6 @@ import Galley.Effects.FederatorAccess import Galley.Effects.GundeckAccess import Galley.Effects.LegalHoldStore as LegalHoldStore import Galley.Effects.MemberStore -import Galley.Effects.Paging import Galley.Effects.TeamStore import qualified Galley.Intra.Push as Intra import Galley.Monad @@ -107,6 +105,8 @@ import Wire.API.Team import Wire.API.Team.Feature import Wire.API.Team.Member import Wire.API.Team.SearchVisibility +import Wire.Sem.Paging +import Wire.Sem.Paging.Cassandra type LegalHoldFeatureStatusChangeErrors = '( 'ActionDenied 'RemoveConversationMember, diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 88993ec0d45..302ef62ad57 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -48,13 +48,11 @@ import Galley.API.Error import Galley.API.Query (iterateConversations) import Galley.API.Update (removeMemberFromLocalConv) import Galley.API.Util -import Galley.Cassandra.Paging import qualified Galley.Data.Conversation as Data import Galley.Effects import Galley.Effects.BrigAccess import Galley.Effects.FireAndForget import qualified Galley.Effects.LegalHoldStore as LegalHoldData -import Galley.Effects.Paging import qualified Galley.Effects.TeamFeatureStore as TeamFeatures import Galley.Effects.TeamMemberStore import Galley.Effects.TeamStore @@ -81,6 +79,8 @@ import qualified Wire.API.Team.LegalHold as Public import Wire.API.Team.LegalHold.External hiding (userId) import Wire.API.Team.Member import Wire.API.User.Client.Prekey +import Wire.Sem.Paging +import Wire.Sem.Paging.Cassandra assertLegalHoldEnabledForTeam :: forall db r. diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 1e55dbe5d73..a84e13cab01 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -68,7 +68,6 @@ import qualified Data.Set as Set import Galley.API.Error import qualified Galley.API.Mapping as Mapping import Galley.API.Util -import Galley.Cassandra.Paging import qualified Galley.Data.Conversation as Data import Galley.Data.Types (Code (codeConversation)) import Galley.Effects @@ -105,6 +104,7 @@ import Wire.API.Federation.Error import qualified Wire.API.Provider.Bot as Public import qualified Wire.API.Routes.MultiTablePaging as Public import Wire.API.Team.Feature as Public hiding (setStatus) +import Wire.Sem.Paging.Cassandra getBotConversationH :: Members '[ConversationStore, ErrorS 'ConvNotFound, Input (Local ())] r => diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d8ad841f396..ca2643e5618 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -87,7 +87,6 @@ import qualified Galley.API.Teams.Notifications as APITeamQueue import qualified Galley.API.Update as API import Galley.API.Util import Galley.App -import Galley.Cassandra.Paging import qualified Galley.Data.Conversation as Data import Galley.Data.Services (BotMember) import Galley.Effects @@ -98,7 +97,6 @@ import qualified Galley.Effects.GundeckAccess as E import qualified Galley.Effects.LegalHoldStore as Data import qualified Galley.Effects.ListItems as E import qualified Galley.Effects.MemberStore as E -import qualified Galley.Effects.Paging as E import qualified Galley.Effects.Queue as E import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData import qualified Galley.Effects.SparAccess as Spar @@ -150,6 +148,8 @@ import Wire.API.User (ScimUserInfo (..), User, UserIdList, UserSSOId (UserScimEx import qualified Wire.API.User as U import Wire.API.User.Identity (UserSSOId (UserSSOId)) import Wire.API.User.RichInfo (RichInfo) +import qualified Wire.Sem.Paging as E +import Wire.Sem.Paging.Cassandra getTeamH :: forall r. diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 4085b746fdb..260781cec44 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -52,12 +52,10 @@ import Galley.API.LegalHold (isLegalHoldEnabledForTeam) import qualified Galley.API.LegalHold as LegalHold import Galley.API.Teams (ensureNotTooLargeToActivateLegalHold) import Galley.API.Util (assertTeamExists, getTeamMembersForFanout, membersToRecipients, permissionCheck) -import Galley.Cassandra.Paging import Galley.Effects import Galley.Effects.BrigAccess (getAccountConferenceCallingConfigClient, updateSearchVisibilityInbound) import Galley.Effects.ConversationStore as ConversationStore import Galley.Effects.GundeckAccess -import Galley.Effects.Paging import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData import Galley.Effects.TeamFeatureStore import qualified Galley.Effects.TeamFeatureStore as TeamFeatures @@ -79,6 +77,8 @@ import qualified Wire.API.Event.FeatureConfig as Event import qualified Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Multi import Wire.API.Team.Feature import Wire.API.Team.Member +import Wire.Sem.Paging +import Wire.Sem.Paging.Cassandra data DoAuth = DoAuth UserId | DontDoAuth diff --git a/services/galley/src/Galley/Cassandra/ConversationList.hs b/services/galley/src/Galley/Cassandra/ConversationList.hs index ae8c03eb06f..93ae9352d72 100644 --- a/services/galley/src/Galley/Cassandra/ConversationList.hs +++ b/services/galley/src/Galley/Cassandra/ConversationList.hs @@ -27,14 +27,13 @@ import Data.Id import Data.Qualified import Data.Range import Galley.Cassandra.Instances () -import Galley.Cassandra.Paging import qualified Galley.Cassandra.Queries as Cql -import Galley.Cassandra.ResultSet import Galley.Cassandra.Store import Galley.Effects.ListItems import Imports hiding (max) import Polysemy import Polysemy.Input +import Wire.Sem.Paging.Cassandra -- | Deprecated, use 'localConversationIdsPageFrom' conversationIdsFrom :: diff --git a/services/galley/src/Galley/Cassandra/ResultSet.hs b/services/galley/src/Galley/Cassandra/ResultSet.hs deleted file mode 100644 index 5d8f801f88a..00000000000 --- a/services/galley/src/Galley/Cassandra/ResultSet.hs +++ /dev/null @@ -1,51 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Galley.Cassandra.ResultSet where - -import Cassandra -import Imports - --- We use this newtype to highlight the fact that the 'Page' wrapped in here --- can not reliably used for paging. --- --- The reason for this is that Cassandra returns 'hasMore' as true if the --- page size requested is equal to result size. To work around this we --- actually request for one additional element and drop the last value if --- necessary. This means however that 'nextPage' does not work properly as --- we would miss a value on every page size. --- Thus, and since we don't want to expose the ResultSet constructor --- because it gives access to `nextPage`, we give accessors to the results --- and a more typed `hasMore` (ResultSetComplete | ResultSetTruncated) -data ResultSet a = ResultSet - { resultSetResult :: [a], - resultSetType :: ResultSetType - } - deriving stock (Show, Functor, Foldable, Traversable) - --- | A more descriptive type than using a simple bool to represent `hasMore` -data ResultSetType - = ResultSetComplete - | ResultSetTruncated - deriving stock (Eq, Show) - -mkResultSet :: Page a -> ResultSet a -mkResultSet page = ResultSet (result page) typ - where - typ - | hasMore page = ResultSetTruncated - | otherwise = ResultSetComplete diff --git a/services/galley/src/Galley/Cassandra/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs index 54c36ea42dc..3156f2fc613 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -41,9 +41,7 @@ import Data.UUID.V4 (nextRandom) import qualified Galley.Aws as Aws import qualified Galley.Cassandra.Conversation as C import Galley.Cassandra.LegalHold (isTeamLegalholdWhitelisted) -import Galley.Cassandra.Paging import qualified Galley.Cassandra.Queries as Cql -import Galley.Cassandra.ResultSet import Galley.Cassandra.Store import Galley.Effects.ListItems import Galley.Effects.TeamMemberStore @@ -61,6 +59,7 @@ import Wire.API.Team import Wire.API.Team.Conversation import Wire.API.Team.Member import Wire.API.Team.Permission (Perm (SetBilling), Permissions, self) +import Wire.Sem.Paging.Cassandra interpretTeamStoreToCassandra :: Members '[Embed IO, Input Env, Input ClientState] r => diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index ca74c9d98d5..3cdcd04dd4f 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -62,7 +62,6 @@ where import Data.Id import Data.Qualified import Data.Time.Clock -import Galley.Cassandra.Paging import Galley.Cassandra.TeamFeatures (Cassandra) import Galley.Effects.BotAccess import Galley.Effects.BrigAccess @@ -94,6 +93,7 @@ import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog import Wire.API.Error +import Wire.Sem.Paging.Cassandra -- All the possible high-level effects. type GalleyEffects1 = diff --git a/services/galley/src/Galley/Effects/ListItems.hs b/services/galley/src/Galley/Effects/ListItems.hs index 8853909a1f6..0e1e4c8e690 100644 --- a/services/galley/src/Galley/Effects/ListItems.hs +++ b/services/galley/src/Galley/Effects/ListItems.hs @@ -24,9 +24,9 @@ module Galley.Effects.ListItems where import Data.Id -import Galley.Effects.Paging import Imports import Polysemy +import Wire.Sem.Paging -- | General pagination-aware list-by-user effect data ListItems p i m a where diff --git a/services/galley/src/Galley/Effects/RemoteConversationListStore.hs b/services/galley/src/Galley/Effects/RemoteConversationListStore.hs index a942f7c6e9f..54a076818ab 100644 --- a/services/galley/src/Galley/Effects/RemoteConversationListStore.hs +++ b/services/galley/src/Galley/Effects/RemoteConversationListStore.hs @@ -26,10 +26,10 @@ where import Data.Id import Data.Qualified -import Galley.Effects.Paging import Galley.Types.Conversations.Members import Imports import Polysemy +import Wire.Sem.Paging data RemoteConversationListStore p m a where ListRemoteConversations :: diff --git a/services/galley/src/Galley/Effects/TeamMemberStore.hs b/services/galley/src/Galley/Effects/TeamMemberStore.hs index eac886b9463..84f2dbca287 100644 --- a/services/galley/src/Galley/Effects/TeamMemberStore.hs +++ b/services/galley/src/Galley/Effects/TeamMemberStore.hs @@ -27,10 +27,10 @@ module Galley.Effects.TeamMemberStore where import Data.Id -import Galley.Effects.Paging import Imports import Polysemy import Wire.API.Team.Member +import Wire.Sem.Paging data TeamMemberStore p m a where ListTeamMembers :: diff --git a/services/galley/src/Galley/Effects/TeamStore.hs b/services/galley/src/Galley/Effects/TeamStore.hs index 5441919cca1..bf2fdbb5664 100644 --- a/services/galley/src/Galley/Effects/TeamStore.hs +++ b/services/galley/src/Galley/Effects/TeamStore.hs @@ -79,7 +79,6 @@ where import Data.Id import Data.Range import Galley.Effects.ListItems -import Galley.Effects.Paging import Galley.Types.Teams import Galley.Types.Teams.Intra import Imports @@ -91,6 +90,7 @@ import Wire.API.Team import Wire.API.Team.Conversation import Wire.API.Team.Member (HardTruncationLimit, TeamMember, TeamMemberList) import Wire.API.Team.Permission +import Wire.Sem.Paging data TeamStore m a where CreateTeamMember :: TeamId -> TeamMember -> TeamStore m () diff --git a/stack.yaml.lock b/stack.yaml.lock index b9126164479..ae8292bdbd6 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -371,6 +371,17 @@ packages: original: git: https://gitlab.com/axeman/swagger commit: e2d3f5b5274b8d8d301b5377b0af4319cea73f9e +- completed: + name: cql-io + version: 1.1.1 + git: https://gitlab.com/axeman/cql-io + pantry-tree: + size: 2172 + sha256: 4eead69907e2fc081d66b9d0ab4f73234f7636220c995147f499777dd14b9250 + commit: c2b6aa995b5817ed7c78c53f72d5aa586ef87c36 + original: + git: https://gitlab.com/axeman/cql-io + commit: c2b6aa995b5817ed7c78c53f72d5aa586ef87c36 - completed: name: cryptobox-haskell version: 0.1.1 @@ -728,13 +739,6 @@ packages: sha256: 94433b7c7c46bea532fdc64c6988643a48e39b643948003b27e5bde1bdad3b24 original: hackage: cql-4.0.3 -- completed: - hackage: cql-io-1.1.1@sha256:897ef0811b227c8b1a269b29b9c1ebfb09c46f00d66834e2e8c6f19ea7f90f7d,4611 - pantry-tree: - size: 2067 - sha256: 7ced76ae95b51fa1669b4fcaeec3825b5cb8cf1f4e37c53d0bddf6234742eba8 - original: - hackage: cql-io-1.1.1 - completed: hackage: primitive-extras-0.10.1.1@sha256:47c4d211166bc31ebdb053f610e4b5387c01d00bde81840e59438469cef6c94e,2955 pantry-tree: