Move paging effect into polysemy-wire-zoo (#2648)

changelog.d/5-internal/generalized-paging

@@ -0,0 +1 @@
+Move Paging effect from galley into polysemy-wire-zoo

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

services/galley/src/Galley/Effects/Paging.hs → 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 <https://www.gnu.org/licenses/>.
 
-module Galley.Effects.Paging
+module Wire.Sem.Paging
   ( -- * General paging types
     Page,
     PagingState,

services/galley/src/Galley/Cassandra/Paging.hs → libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs

@@ -15,17 +15,16 @@
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
-module Galley.Cassandra.Paging
+module Wire.Sem.Paging.Cassandra
   ( CassandraPaging,
     LegacyPaging,
     InternalPaging,
     InternalPage (..),
     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

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

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,

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.

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 =>

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.

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
 

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 ::

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 =>

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 =

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

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 ::

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 ::

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 ()