From b01be38787c162a77b6f4566560ea34cda08931d Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 19 Aug 2022 20:54:12 -0700 Subject: [PATCH 01/13] feat: implement UserPendingActivationStore effect --- services/brig/brig.cabal | 3 +- services/brig/src/Brig/API.hs | 4 +- services/brig/src/Brig/API/Internal.hs | 29 +++++++-- services/brig/src/Brig/API/Public.hs | 13 +++- services/brig/src/Brig/API/User.hs | 28 +++++++-- .../brig/src/Brig/CanonicalInterpreter.hs | 4 ++ .../src/Brig/Data/UserPendingActivation.hs | 62 ------------------- services/brig/src/Brig/Run.hs | 10 +-- .../Brig/Sem/UserPendingActivationStore.hs | 25 ++++++++ .../UserPendingActivationStore/Cassandra.hs | 46 ++++++++++++++ services/brig/src/Brig/Team/API.hs | 29 +++++++-- 11 files changed, 169 insertions(+), 84 deletions(-) delete mode 100644 services/brig/src/Brig/Data/UserPendingActivation.hs create mode 100644 services/brig/src/Brig/Sem/UserPendingActivationStore.hs create mode 100644 services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index b91e6632499..81158dfd1c6 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -53,7 +53,6 @@ library Brig.Data.Types Brig.Data.User Brig.Data.UserKey - Brig.Data.UserPendingActivation Brig.Effects.BlacklistPhonePrefixStore Brig.Effects.BlacklistPhonePrefixStore.Cassandra Brig.Effects.BlacklistStore @@ -89,6 +88,8 @@ library Brig.Sem.CodeStore.Cassandra Brig.Sem.PasswordResetStore Brig.Sem.PasswordResetStore.CodeStore + Brig.Sem.UserPendingActivationStore + Brig.Sem.UserPendingActivationStore.Cassandra Brig.SMTP Brig.Team.API Brig.Team.DB diff --git a/services/brig/src/Brig/API.hs b/services/brig/src/Brig/API.hs index 61483fc0bb1..4334ed0f042 100644 --- a/services/brig/src/Brig/API.hs +++ b/services/brig/src/Brig/API.hs @@ -27,6 +27,7 @@ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import Brig.Effects.BlacklistStore (BlacklistStore) import Brig.Sem.CodeStore import Brig.Sem.PasswordResetStore (PasswordResetStore) +import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) import qualified Data.Swagger.Build.Api as Doc import Network.Wai.Routing (Routes) import Polysemy @@ -36,7 +37,8 @@ sitemap :: '[ CodeStore, PasswordResetStore, BlacklistStore, - BlacklistPhonePrefixStore + BlacklistPhonePrefixStore, + UserPendingActivationStore ] r => Routes Doc.ApiBuilder (Handler r) () diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index c2e871490f4..8e85731bd3d 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -46,6 +46,7 @@ import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Provider.API as Provider import Brig.Sem.CodeStore (CodeStore) import Brig.Sem.PasswordResetStore (PasswordResetStore) +import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Team.API as Team import Brig.Team.DB (lookupInvitationByEmail) import Brig.Types.Connection @@ -100,7 +101,13 @@ import Wire.API.User.RichInfo --------------------------------------------------------------------------- -- Sitemap (servant) -servantSitemap :: Members '[BlacklistStore] r => ServerT BrigIRoutes.API (Handler r) +servantSitemap :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + ServerT BrigIRoutes.API (Handler r) servantSitemap = ejpdAPI :<|> accountAPI :<|> mlsAPI :<|> getVerificationCode :<|> teamsAPI :<|> userAPI ejpdAPI :: ServerT BrigIRoutes.EJPD_API (Handler r) @@ -125,7 +132,13 @@ mlsAPI = :<|> getMLSClients :<|> mapKeyPackageRefsInternal -accountAPI :: Member BlacklistStore r => ServerT BrigIRoutes.AccountAPI (Handler r) +accountAPI :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + ServerT BrigIRoutes.AccountAPI (Handler r) accountAPI = Named @"createUserNoVerify" createUserNoVerify :<|> Named @"createUserNoVerifySpar" createUserNoVerifySpar @@ -214,7 +227,8 @@ sitemap :: '[ CodeStore, PasswordResetStore, BlacklistStore, - BlacklistPhonePrefixStore + BlacklistPhonePrefixStore, + UserPendingActivationStore ] r => Routes a (Handler r) () @@ -420,7 +434,14 @@ internalListFullClients :: UserSet -> (AppT r) UserClientsFull internalListFullClients (UserSet usrs) = UserClientsFull <$> wrapClient (Data.lookupClientsBulk (Set.toList usrs)) -createUserNoVerify :: Member BlacklistStore r => NewUser -> (Handler r) (Either RegisterError SelfProfile) +createUserNoVerify :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + NewUser -> + (Handler r) (Either RegisterError SelfProfile) createUserNoVerify uData = lift . runExceptT $ do result <- API.createUser uData let acc = createdAccount result diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 09ed538c151..e790bd6bd69 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -50,6 +50,7 @@ import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Provider.API as Provider import Brig.Sem.CodeStore (CodeStore) import Brig.Sem.PasswordResetStore (PasswordResetStore) +import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Team.API as Team import qualified Brig.Team.Email as Team import Brig.Types.Activation (ActivationPair) @@ -186,7 +187,8 @@ servantSitemap :: forall r. Members '[ BlacklistStore, - BlacklistPhonePrefixStore + BlacklistPhonePrefixStore, + UserPendingActivationStore ] r => ServerT BrigAPI (Handler r) @@ -614,7 +616,14 @@ getClientPrekeys :: UserId -> ClientId -> (Handler r) [Public.PrekeyId] getClientPrekeys usr clt = lift (wrapClient $ API.lookupPrekeyIds usr clt) -- | docs/reference/user/registration.md {#RefRegistration} -createUser :: Member BlacklistStore r => Public.NewUserPublic -> (Handler r) (Either Public.RegisterError Public.RegisterSuccess) +createUser :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + Public.NewUserPublic -> + (Handler r) (Either Public.RegisterError Public.RegisterSuccess) createUser (Public.NewUserPublic new) = lift . runExceptT $ do API.checkRestrictedUserCreation new for_ (Public.newUserEmail new) $ mapExceptT wrapHttp . checkWhitelistWithError RegisterErrorWhitelistError . Left diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 3ba1eb47c31..db62880f0a5 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -106,8 +106,6 @@ import Brig.Data.User import qualified Brig.Data.User as Data import Brig.Data.UserKey import qualified Brig.Data.UserKey as Data -import Brig.Data.UserPendingActivation -import qualified Brig.Data.UserPendingActivation as Data import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore) import qualified Brig.Effects.BlacklistPhonePrefixStore as BlacklistPhonePrefixStore import Brig.Effects.BlacklistStore (BlacklistStore) @@ -122,6 +120,8 @@ import Brig.Sem.CodeStore (CodeStore) import qualified Brig.Sem.CodeStore as E import Brig.Sem.PasswordResetStore (PasswordResetStore) import qualified Brig.Sem.PasswordResetStore as E +import Brig.Sem.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore) +import qualified Brig.Sem.UserPendingActivationStore as UserPendingActivationStore import qualified Brig.Team.DB as Team import Brig.Types.Activation (ActivationPair) import Brig.Types.Connection @@ -277,7 +277,15 @@ createUserSpar new = do pure $ CreateUserTeam tid nm -- docs/reference/user/registration.md {#RefRegistration} -createUser :: forall r. Member BlacklistStore r => NewUser -> ExceptT RegisterError (AppT r) CreateUserResult +createUser :: + forall r. + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + NewUser -> + ExceptT RegisterError (AppT r) CreateUserResult createUser new = do (email, phone) <- validateEmailAndPhone new @@ -448,8 +456,8 @@ createUser new = do field "user" (toByteString uid) . field "team" (toByteString $ Team.iiTeam ii) . msg (val "Accepting invitation") + liftSem $ UserPendingActivationStore.remove uid wrapClient $ do - Data.usersPendingActivationRemove uid Team.deleteInvitation (Team.inTeam inv) (Team.inInvitation inv) addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> ExceptT RegisterError (AppT r) CreateUserTeam @@ -512,7 +520,15 @@ initAccountFeatureConfig uid = do -- | 'createUser' is becoming hard to maintian, and instead of adding more case distinctions -- all over the place there, we add a new function that handles just the one new flow where -- users are invited to the team via scim. -createUserInviteViaScim :: Member BlacklistStore r => UserId -> NewUserScimInvitation -> ExceptT Error.Error (AppT r) UserAccount +createUserInviteViaScim :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + UserId -> + NewUserScimInvitation -> + ExceptT Error.Error (AppT r) UserAccount createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = do email <- either (const . throwE . Error.StdError $ errorToWai @'E.InvalidEmail) pure (validateEmail rawEmail) let emKey = userEmailKey email @@ -526,7 +542,7 @@ createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = do ttl <- setTeamInvitationTimeout <$> view settings now <- liftIO =<< view currentTime pure $ addUTCTime (realToFrac ttl) now - lift . wrapClient $ Data.usersPendingActivationAdd (UserPendingActivation uid expiresAt) + lift . liftSem $ UserPendingActivationStore.add (UserPendingActivation uid expiresAt) let activated = -- treating 'PendingActivation' as 'Active', but then 'Brig.Data.User.toIdentity' diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 72ae9ee2cb9..758df5bd946 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -9,6 +9,8 @@ import Brig.Sem.CodeStore (CodeStore) import Brig.Sem.CodeStore.Cassandra (codeStoreToCassandra, interpretClientToIO) import Brig.Sem.PasswordResetStore (PasswordResetStore) import Brig.Sem.PasswordResetStore.CodeStore (passwordResetStoreToCodeStore) +import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) +import Brig.Sem.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra) import qualified Cassandra as Cas import Control.Lens ((^.)) import Imports @@ -20,6 +22,7 @@ type BrigCanonicalEffects = '[ BlacklistPhonePrefixStore, BlacklistStore, PasswordResetStore, + UserPendingActivationStore, Now, CodeStore, Embed Cas.Client, @@ -34,6 +37,7 @@ runBrigToIO e (AppT ma) = . interpretClientToIO (e ^. casClient) . codeStoreToCassandra @Cas.Client . nowToIOAction (e ^. currentTime) + . userPendingActivationStoreToCassandra @Cas.Client . passwordResetStoreToCodeStore . interpretBlacklistStoreToCassandra @Cas.Client . interpretBlacklistPhonePrefixStoreToCassandra @Cas.Client diff --git a/services/brig/src/Brig/Data/UserPendingActivation.hs b/services/brig/src/Brig/Data/UserPendingActivation.hs deleted file mode 100644 index 23a56684281..00000000000 --- a/services/brig/src/Brig/Data/UserPendingActivation.hs +++ /dev/null @@ -1,62 +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 Brig.Data.UserPendingActivation - ( usersPendingActivationAdd, - usersPendingActivationList, - usersPendingActivationRemove, - usersPendingActivationRemoveMultiple, - UserPendingActivation (..), - ) -where - -import Cassandra -import Data.Id (UserId) -import Data.Time (UTCTime) -import Imports - -data UserPendingActivation = UserPendingActivation - { upaUserId :: !UserId, - upaDay :: !UTCTime - } - deriving stock (Eq, Show, Ord) - -usersPendingActivationAdd :: MonadClient m => UserPendingActivation -> m () -usersPendingActivationAdd (UserPendingActivation uid expiresAt) = do - retry x5 . write insertExpiration . params LocalQuorum $ (uid, expiresAt) - where - insertExpiration :: PrepQuery W (UserId, UTCTime) () - insertExpiration = "INSERT INTO users_pending_activation (user, expires_at) VALUES (?, ?)" - -usersPendingActivationList :: MonadClient m => m (Page UserPendingActivation) -usersPendingActivationList = do - uncurry UserPendingActivation <$$> retry x1 (paginate selectExpired (params LocalQuorum ())) - where - selectExpired :: PrepQuery R () (UserId, UTCTime) - selectExpired = - "SELECT user, expires_at FROM users_pending_activation" - -usersPendingActivationRemove :: MonadClient m => UserId -> m () -usersPendingActivationRemove uid = usersPendingActivationRemoveMultiple [uid] - -usersPendingActivationRemoveMultiple :: MonadClient m => [UserId] -> m () -usersPendingActivationRemoveMultiple uids = - retry x5 . write deleteExpired . params LocalQuorum $ Identity uids - where - deleteExpired :: PrepQuery W (Identity [UserId]) () - deleteExpired = - "DELETE FROM users_pending_activation WHERE user IN ?" diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 3e20d9fddf8..0399a364347 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -36,10 +36,11 @@ import qualified Brig.AWS.SesNotification as SesNotification import Brig.App import qualified Brig.Calling as Calling import Brig.CanonicalInterpreter -import Brig.Data.UserPendingActivation (UserPendingActivation (..), usersPendingActivationList, usersPendingActivationRemoveMultiple) import qualified Brig.InternalEvent.Process as Internal import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Queue as Queue +import Brig.Sem.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) +import qualified Brig.Sem.UserPendingActivationStore as UsersPendingActivationStore import Brig.Types.Intra (AccountStatus (PendingInvitation)) import Brig.Version import Cassandra (Page (Page)) @@ -67,6 +68,7 @@ import Network.Wai.Routing.Route (App) import Network.Wai.Utilities (lookupRequestId) import Network.Wai.Utilities.Server import qualified Network.Wai.Utilities.Server as Server +import Polysemy (Members) import Servant (Context ((:.)), (:<|>) (..)) import qualified Servant import System.Logger (msg, val, (.=), (~~)) @@ -180,7 +182,7 @@ bodyParserErrorFormatter _ _ errMsg = Servant.errHeaders = [(HTTP.hContentType, HTTPMedia.renderHeader (Servant.contentType (Proxy @Servant.JSON)))] } -pendingActivationCleanup :: forall r. AppT r () +pendingActivationCleanup :: forall r. Members '[UserPendingActivationStore] r => AppT r () pendingActivationCleanup = do safeForever "pendingActivationCleanup" $ do now <- liftIO =<< view currentTime @@ -200,7 +202,7 @@ pendingActivationCleanup = do if isExpired && isPendingInvitation then Just uid else Nothing ) - wrapClient . usersPendingActivationRemoveMultiple $ + liftSem . UsersPendingActivationStore.removeMultiple $ catMaybes ( uids <&> \(isExpired, _isPendingInvitation, uid) -> if isExpired then Just uid else Nothing @@ -218,7 +220,7 @@ pendingActivationCleanup = do forExpirationsPaged :: ([UserPendingActivation] -> (AppT r) ()) -> (AppT r) () forExpirationsPaged f = do - go =<< wrapClient usersPendingActivationList + go =<< liftSem UsersPendingActivationStore.list where go :: Page UserPendingActivation -> (AppT r) () go (Page hasMore result nextPage) = do diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs new file mode 100644 index 00000000000..671b93854c1 --- /dev/null +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Brig.Sem.UserPendingActivationStore where + +import Cassandra +import Data.Id +import Data.Time.Clock +import Imports +import Polysemy + +data UserPendingActivation = UserPendingActivation + { upaUserId :: !UserId, + upaDay :: !UTCTime + } + deriving stock (Eq, Show, Ord) + +data UserPendingActivationStore m a where + Add :: UserPendingActivation -> UserPendingActivationStore m () + List :: UserPendingActivationStore m (Page UserPendingActivation) + RemoveMultiple :: [UserId] -> UserPendingActivationStore m () + +makeSem ''UserPendingActivationStore + +remove :: Member UserPendingActivationStore r => UserId -> Sem r () +remove uid = removeMultiple [uid] diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs new file mode 100644 index 00000000000..4952798b340 --- /dev/null +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -0,0 +1,46 @@ +module Brig.Sem.UserPendingActivationStore.Cassandra + ( userPendingActivationStoreToCassandra, + ) +where + +import Brig.Sem.UserPendingActivationStore +import Cassandra +import Data.Id (UserId) +import Data.Time (UTCTime) +import Imports +import Polysemy + +userPendingActivationStoreToCassandra :: + forall m r a. + (MonadClient m, Member (Embed m) r) => + Sem (UserPendingActivationStore ': r) a -> + Sem r a +userPendingActivationStoreToCassandra = + interpret $ + embed @m . \case + Add upa -> usersPendingActivationAdd upa + List -> usersPendingActivationList + RemoveMultiple uids -> usersPendingActivationRemoveMultiple uids + +usersPendingActivationAdd :: MonadClient m => UserPendingActivation -> m () +usersPendingActivationAdd (UserPendingActivation uid expiresAt) = do + retry x5 . write insertExpiration . params LocalQuorum $ (uid, expiresAt) + where + insertExpiration :: PrepQuery W (UserId, UTCTime) () + insertExpiration = "INSERT INTO users_pending_activation (user, expires_at) VALUES (?, ?)" + +usersPendingActivationList :: MonadClient m => m (Page UserPendingActivation) +usersPendingActivationList = do + uncurry UserPendingActivation <$$> retry x1 (paginate selectExpired (params LocalQuorum ())) + where + selectExpired :: PrepQuery R () (UserId, UTCTime) + selectExpired = + "SELECT user, expires_at FROM users_pending_activation" + +usersPendingActivationRemoveMultiple :: MonadClient m => [UserId] -> m () +usersPendingActivationRemoveMultiple uids = + retry x5 . write deleteExpired . params LocalQuorum $ Identity uids + where + deleteExpired :: PrepQuery W (Identity [UserId]) () + deleteExpired = + "DELETE FROM users_pending_activation WHERE user IN ?" diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index a8fefecf984..43620874864 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -35,6 +35,7 @@ import qualified Brig.Email as Email import qualified Brig.IO.Intra as Intra import Brig.Options (setMaxTeamSize, setTeamInvitationTimeout) import qualified Brig.Phone as Phone +import Brig.Sem.UserPendingActivationStore (UserPendingActivationStore) import qualified Brig.Team.DB as DB import Brig.Team.Email import Brig.Team.Util (ensurePermissionToAddUser, ensurePermissions) @@ -60,7 +61,7 @@ import Network.Wai.Routing import Network.Wai.Utilities hiding (code, message) import Network.Wai.Utilities.Swagger (document) import qualified Network.Wai.Utilities.Swagger as Doc -import Polysemy (Member) +import Polysemy (Member, Members) import System.Logger (Msg) import qualified System.Logger.Class as Log import Util.Logging (logFunction, logTeam) @@ -188,7 +189,13 @@ routesPublic = do Doc.response 200 "Invitation successful." Doc.end Doc.response 403 "No permission (not admin or owner of this team)." Doc.end -routesInternal :: Member BlacklistStore r => Routes a (Handler r) () +routesInternal :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + Routes a (Handler r) () routesInternal = do get "/i/teams/invitations/by-email" (continue getInvitationByEmailH) $ accept "application" "json" @@ -280,12 +287,26 @@ createInvitationPublic uid tid body = do context (createInvitation' tid inviteeRole (Just (inviterUid inviter)) (inviterEmail inviter) body) -createInvitationViaScimH :: Member BlacklistStore r => JSON ::: JsonRequest NewUserScimInvitation -> (Handler r) Response +createInvitationViaScimH :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + JSON ::: JsonRequest NewUserScimInvitation -> + (Handler r) Response createInvitationViaScimH (_ ::: req) = do body <- parseJsonBody req setStatus status201 . json <$> createInvitationViaScim body -createInvitationViaScim :: Member BlacklistStore r => NewUserScimInvitation -> (Handler r) UserAccount +createInvitationViaScim :: + Members + '[ BlacklistStore, + UserPendingActivationStore + ] + r => + NewUserScimInvitation -> + (Handler r) UserAccount createInvitationViaScim newUser@(NewUserScimInvitation tid loc name email) = do env <- ask let inviteeRole = defaultRole From 3004be8b8d4c28545e4db0dd2d0218ea578791a4 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Fri, 19 Aug 2022 21:46:16 -0700 Subject: [PATCH 02/13] wip: try to implement paginatation in polysemy --- .../Brig/Sem/UserPendingActivationStore.hs | 4 +-- .../UserPendingActivationStore/Cassandra.hs | 33 +++++++++++++++---- 2 files changed, 28 insertions(+), 9 deletions(-) diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs index 671b93854c1..4b7e672a3b0 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs @@ -2,11 +2,11 @@ module Brig.Sem.UserPendingActivationStore where -import Cassandra import Data.Id import Data.Time.Clock import Imports import Polysemy +import Conduit (ConduitT) data UserPendingActivation = UserPendingActivation { upaUserId :: !UserId, @@ -16,7 +16,7 @@ data UserPendingActivation = UserPendingActivation data UserPendingActivationStore m a where Add :: UserPendingActivation -> UserPendingActivationStore m () - List :: UserPendingActivationStore m (Page UserPendingActivation) + List :: UserPendingActivationStore m (ConduitT () [UserPendingActivation] m ()) RemoveMultiple :: [UserId] -> UserPendingActivationStore m () makeSem ''UserPendingActivationStore diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs index 4952798b340..36a6a931113 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -9,18 +9,37 @@ import Data.Id (UserId) import Data.Time (UTCTime) import Imports import Polysemy +import Polysemy.Internal.Tactics (liftT) +import Conduit userPendingActivationStoreToCassandra :: - forall m r a. - (MonadClient m, Member (Embed m) r) => + forall r a. + (Member (Embed Client) r) => Sem (UserPendingActivationStore ': r) a -> Sem r a userPendingActivationStoreToCassandra = - interpret $ - embed @m . \case - Add upa -> usersPendingActivationAdd upa - List -> usersPendingActivationList - RemoveMultiple uids -> usersPendingActivationRemoveMultiple uids + interpretH $ + \case + Add upa -> liftT $ embed @Client $ usersPendingActivationAdd upa + List -> do + page <- liftT $ embed @Client $ usersPendingActivationList + cont <- bindT (pure . paginateToConduit @r) + z <- raise $ userPendingActivationStoreToCassandra $ cont page + pure $ fmap (hoistConduit _) z + -- pure $ fmap paginateToConduit page + RemoveMultiple uids -> do + liftT $ embed @Client $ usersPendingActivationRemoveMultiple uids + + +hoistConduit :: (Monad m, Monad n) => (forall x. m x -> n x) -> ConduitT i o m a -> ConduitT i o n a +hoistConduit f = undefined + +paginateToConduit :: forall r a. (Member (Embed Client) r) => Page a -> ConduitT () [a] (Sem r) () +paginateToConduit (Page False as _) = yield as +paginateToConduit (Page True as more) = do + yield as + m <- lift $ embed more + paginateToConduit m usersPendingActivationAdd :: MonadClient m => UserPendingActivation -> m () usersPendingActivationAdd (UserPendingActivation uid expiresAt) = do From bb1296ab4c80dd7a569a6bec0238a3ff354f5507 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sat, 20 Aug 2022 23:10:32 -0700 Subject: [PATCH 03/13] more wip --- .../UserPendingActivationStore/Cassandra.hs | 28 +++++++++++++++---- 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs index 36a6a931113..c1576e4e3ee 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE PartialTypeSignatures #-} + +{-# OPTIONS_GHC -Wno-partial-type-signatures #-} + module Brig.Sem.UserPendingActivationStore.Cassandra ( userPendingActivationStoreToCassandra, ) @@ -11,21 +15,33 @@ import Imports import Polysemy import Polysemy.Internal.Tactics (liftT) import Conduit +import Polysemy.Final userPendingActivationStoreToCassandra :: forall r a. - (Member (Embed Client) r) => + ( Member (Embed Client) r + , Member (Final IO) r + ) => Sem (UserPendingActivationStore ': r) a -> Sem r a userPendingActivationStoreToCassandra = interpretH $ \case Add upa -> liftT $ embed @Client $ usersPendingActivationAdd upa - List -> do - page <- liftT $ embed @Client $ usersPendingActivationList - cont <- bindT (pure . paginateToConduit @r) - z <- raise $ userPendingActivationStoreToCassandra $ cont page - pure $ fmap (hoistConduit _) z + (List :: UserPendingActivationStore (Sem r0) _) -> do + st0 <- getInitialStateT + withWeavingToFinal @IO $ \st lower ins -> do + fconduit + <- fmap (fmap $ paginateToConduit @r0) + $ lower + $ embed @Client usersPendingActivationList <$ st + let Just conduit = ins fconduit + + (z :: _ (ConduitT () [UserPendingActivation] (Sem r0) ())) <- _ + pure $ fmap (<$ st0) z + -- cont <- bindT (pure . paginateToConduit @r) + -- z <- raise $ userPendingActivationStoreToCassandra $ cont page + -- pure $ fmap (hoistConduit _) z -- pure $ fmap paginateToConduit page RemoveMultiple uids -> do liftT $ embed @Client $ usersPendingActivationRemoveMultiple uids From a3a1870fcf8aa66d2c4d2c70e778a8964ef1c8b3 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sat, 20 Aug 2022 23:10:45 -0700 Subject: [PATCH 04/13] Revert "more wip" This reverts commit bb1296ab4c80dd7a569a6bec0238a3ff354f5507. --- .../UserPendingActivationStore/Cassandra.hs | 28 ++++--------------- 1 file changed, 6 insertions(+), 22 deletions(-) diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs index c1576e4e3ee..36a6a931113 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE PartialTypeSignatures #-} - -{-# OPTIONS_GHC -Wno-partial-type-signatures #-} - module Brig.Sem.UserPendingActivationStore.Cassandra ( userPendingActivationStoreToCassandra, ) @@ -15,33 +11,21 @@ import Imports import Polysemy import Polysemy.Internal.Tactics (liftT) import Conduit -import Polysemy.Final userPendingActivationStoreToCassandra :: forall r a. - ( Member (Embed Client) r - , Member (Final IO) r - ) => + (Member (Embed Client) r) => Sem (UserPendingActivationStore ': r) a -> Sem r a userPendingActivationStoreToCassandra = interpretH $ \case Add upa -> liftT $ embed @Client $ usersPendingActivationAdd upa - (List :: UserPendingActivationStore (Sem r0) _) -> do - st0 <- getInitialStateT - withWeavingToFinal @IO $ \st lower ins -> do - fconduit - <- fmap (fmap $ paginateToConduit @r0) - $ lower - $ embed @Client usersPendingActivationList <$ st - let Just conduit = ins fconduit - - (z :: _ (ConduitT () [UserPendingActivation] (Sem r0) ())) <- _ - pure $ fmap (<$ st0) z - -- cont <- bindT (pure . paginateToConduit @r) - -- z <- raise $ userPendingActivationStoreToCassandra $ cont page - -- pure $ fmap (hoistConduit _) z + List -> do + page <- liftT $ embed @Client $ usersPendingActivationList + cont <- bindT (pure . paginateToConduit @r) + z <- raise $ userPendingActivationStoreToCassandra $ cont page + pure $ fmap (hoistConduit _) z -- pure $ fmap paginateToConduit page RemoveMultiple uids -> do liftT $ embed @Client $ usersPendingActivationRemoveMultiple uids From 873c45be757f352896c7c1284dd6cc5a37b28116 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sat, 20 Aug 2022 23:10:53 -0700 Subject: [PATCH 05/13] Revert "wip: try to implement paginatation in polysemy" This reverts commit 3004be8b8d4c28545e4db0dd2d0218ea578791a4. --- .../Brig/Sem/UserPendingActivationStore.hs | 4 +-- .../UserPendingActivationStore/Cassandra.hs | 33 ++++--------------- 2 files changed, 9 insertions(+), 28 deletions(-) diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs index 4b7e672a3b0..671b93854c1 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs @@ -2,11 +2,11 @@ module Brig.Sem.UserPendingActivationStore where +import Cassandra import Data.Id import Data.Time.Clock import Imports import Polysemy -import Conduit (ConduitT) data UserPendingActivation = UserPendingActivation { upaUserId :: !UserId, @@ -16,7 +16,7 @@ data UserPendingActivation = UserPendingActivation data UserPendingActivationStore m a where Add :: UserPendingActivation -> UserPendingActivationStore m () - List :: UserPendingActivationStore m (ConduitT () [UserPendingActivation] m ()) + List :: UserPendingActivationStore m (Page UserPendingActivation) RemoveMultiple :: [UserId] -> UserPendingActivationStore m () makeSem ''UserPendingActivationStore diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs index 36a6a931113..4952798b340 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -9,37 +9,18 @@ import Data.Id (UserId) import Data.Time (UTCTime) import Imports import Polysemy -import Polysemy.Internal.Tactics (liftT) -import Conduit userPendingActivationStoreToCassandra :: - forall r a. - (Member (Embed Client) r) => + forall m r a. + (MonadClient m, Member (Embed m) r) => Sem (UserPendingActivationStore ': r) a -> Sem r a userPendingActivationStoreToCassandra = - interpretH $ - \case - Add upa -> liftT $ embed @Client $ usersPendingActivationAdd upa - List -> do - page <- liftT $ embed @Client $ usersPendingActivationList - cont <- bindT (pure . paginateToConduit @r) - z <- raise $ userPendingActivationStoreToCassandra $ cont page - pure $ fmap (hoistConduit _) z - -- pure $ fmap paginateToConduit page - RemoveMultiple uids -> do - liftT $ embed @Client $ usersPendingActivationRemoveMultiple uids - - -hoistConduit :: (Monad m, Monad n) => (forall x. m x -> n x) -> ConduitT i o m a -> ConduitT i o n a -hoistConduit f = undefined - -paginateToConduit :: forall r a. (Member (Embed Client) r) => Page a -> ConduitT () [a] (Sem r) () -paginateToConduit (Page False as _) = yield as -paginateToConduit (Page True as more) = do - yield as - m <- lift $ embed more - paginateToConduit m + interpret $ + embed @m . \case + Add upa -> usersPendingActivationAdd upa + List -> usersPendingActivationList + RemoveMultiple uids -> usersPendingActivationRemoveMultiple uids usersPendingActivationAdd :: MonadClient m => UserPendingActivation -> m () usersPendingActivationAdd (UserPendingActivation uid expiresAt) = do From 13abfdbe307ca33311abd4101f9e2cb2c74df1ef Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 21 Aug 2022 00:04:39 -0700 Subject: [PATCH 06/13] fix: reimplement page streaming --- .../brig/src/Brig/CanonicalInterpreter.hs | 2 +- services/brig/src/Brig/Run.hs | 10 +-- .../Brig/Sem/UserPendingActivationStore.hs | 65 ++++++++++++++++++- .../UserPendingActivationStore/Cassandra.hs | 31 +++++++-- 4 files changed, 93 insertions(+), 15 deletions(-) diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 758df5bd946..87261ab82e4 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -37,7 +37,7 @@ runBrigToIO e (AppT ma) = . interpretClientToIO (e ^. casClient) . codeStoreToCassandra @Cas.Client . nowToIOAction (e ^. currentTime) - . userPendingActivationStoreToCassandra @Cas.Client + . userPendingActivationStoreToCassandra . passwordResetStoreToCodeStore . interpretBlacklistStoreToCassandra @Cas.Client . interpretBlacklistPhonePrefixStoreToCassandra @Cas.Client diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 0399a364347..d202499f2cd 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -40,10 +40,10 @@ import qualified Brig.InternalEvent.Process as Internal import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Queue as Queue import Brig.Sem.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) +import qualified Brig.Sem.UserPendingActivationStore as E import qualified Brig.Sem.UserPendingActivationStore as UsersPendingActivationStore import Brig.Types.Intra (AccountStatus (PendingInvitation)) import Brig.Version -import Cassandra (Page (Page)) import qualified Control.Concurrent.Async as Async import Control.Exception.Safe (catchAny) import Control.Lens (view, (.~), (^.)) @@ -222,11 +222,11 @@ pendingActivationCleanup = do forExpirationsPaged f = do go =<< liftSem UsersPendingActivationStore.list where - go :: Page UserPendingActivation -> (AppT r) () - go (Page hasMore result nextPage) = do + -- go :: E.Page _ UserPendingActivation -> (AppT r) () + go (E.Page result maybeNextPageKey) = do f result - when hasMore $ - go =<< wrapClient (lift nextPage) + for_ maybeNextPageKey $ \key -> + go =<< liftSem (UsersPendingActivationStore.getNext key) threadDelayRandom :: (AppT r) () threadDelayRandom = do diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs index 671b93854c1..3fa9339d2c7 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs @@ -1,11 +1,12 @@ +{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TemplateHaskell #-} module Brig.Sem.UserPendingActivationStore where -import Cassandra import Data.Id import Data.Time.Clock -import Imports +import GHC.Exts (Any) +import Imports hiding (Any) import Polysemy data UserPendingActivation = UserPendingActivation @@ -14,9 +15,67 @@ data UserPendingActivation = UserPendingActivation } deriving stock (Eq, Show, Ord) +-- | A backend-independent paging mechanism, with immediate results and +-- possibly a 'NextPageToken' which can be used by 'getNext' to load the next +-- page. +data Page m a = Page + { results :: [a], + nextPageToken :: Maybe (NextPageToken m a) + } + +type role Page nominal nominal + +-- | An interpretation-specific means of performign paging. In an ideal world, +-- paging could just return a @ConduitT () o (Sem r) ()@, but this thing is +-- impossible to implement given the available polysemy tools --- at least, +-- without forcing the entire stream immediately. +-- +-- Instead, we're left needing to pump the paging mechanism ourselves, see the +-- 'getNext' action. This would be fine, except that different interpretations +-- are going to require different types of state to implement their paging. +-- A type family would be ideal here, but unfortunately we can't attach type +-- instances to *interpretations*. +-- +-- So instead we do a dirty, awful thing where we use 'Any' and just +-- 'Unsafe.Coerce.unsafeCoece' to and from it. I know. I'm sorry. +-- Interpretations are responsible for consistently coercing 'getNextPage'. +-- +-- Despite all of this, it's not as horrible as it sounds. Assuming the +-- interpreter is consistent in its usage, we are protected by three things: +-- +-- 1. The 'NextPageToken' itself is well-typed with respect to what it can +-- produce. It has nominal roles to ensure users can't break the invariants. +-- +-- 2. The @m@ type variable is used for the ST-trick, where we tie it to the +-- same monadic context in which polysemy is running its effects. Thus we +-- are guaranteed that the only 'NextPageToken' that will typecheck when +-- passed to 'getNext' actually came from a corresponding call to 'list' +-- _within the same interpretation._ +-- +-- 3. There is a WARNING pragma attached to the data constructor, meaning any +-- user who attempts to build one will get yelled at. Unfortunately, we need +-- to expose a means of constructing this type so interpreter authors can +-- use it, but a WARNING is the next best thing. +-- +-- Interpretation authors may use @-fno-warn-deprecations@ to disable this +-- WARNING. +data NextPageToken m a = ExtremelyUnsafeNextPageToken + { getNextPage :: Any + } + +type role NextPageToken nominal nominal + +{-# WARNING + ExtremelyUnsafeNextPageToken + "Under NO CIRCUMSTANCES should you construct a NextPageToken in application code. \ + \If you are implementing an interpreter, read the haddocks on NextPageToken for \ + \information on what to do and how to turn off this warning." + #-} + data UserPendingActivationStore m a where Add :: UserPendingActivation -> UserPendingActivationStore m () - List :: UserPendingActivationStore m (Page UserPendingActivation) + List :: UserPendingActivationStore m (Page m UserPendingActivation) + GetNext :: NextPageToken m UserPendingActivation -> UserPendingActivationStore m (Page m UserPendingActivation) RemoveMultiple :: [UserId] -> UserPendingActivationStore m () makeSem ''UserPendingActivationStore diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs index 4952798b340..d9f6637c9be 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -1,27 +1,46 @@ +-- See note on 'NextPageToken' +{-# OPTIONS_GHC -fno-warn-deprecations #-} + module Brig.Sem.UserPendingActivationStore.Cassandra ( userPendingActivationStoreToCassandra, ) where -import Brig.Sem.UserPendingActivationStore +import Brig.Sem.UserPendingActivationStore hiding (Page) +import qualified Brig.Sem.UserPendingActivationStore as E import Cassandra import Data.Id (UserId) import Data.Time (UTCTime) import Imports import Polysemy +import Polysemy.Internal.Tactics +import Unsafe.Coerce (unsafeCoerce) userPendingActivationStoreToCassandra :: - forall m r a. - (MonadClient m, Member (Embed m) r) => + forall r a. + (Member (Embed Client) r) => Sem (UserPendingActivationStore ': r) a -> Sem r a userPendingActivationStoreToCassandra = - interpret $ - embed @m . \case + interpretH $ + liftT . embed @Client . \case Add upa -> usersPendingActivationAdd upa - List -> usersPendingActivationList + List -> + fmap cassandraPageToEffectPage $ usersPendingActivationList + GetNext nkt -> + fmap cassandraPageToEffectPage $ unsafeFromNextKeyToken nkt RemoveMultiple uids -> usersPendingActivationRemoveMultiple uids +cassandraPageToEffectPage :: Page a -> E.Page unique a +cassandraPageToEffectPage (Page more results nextPage) = + E.Page results $ bool Nothing (Just $ unsafeToNextKeyToken nextPage) more + +unsafeToNextKeyToken :: Client (Page a) -> NextPageToken unique a +unsafeToNextKeyToken = ExtremelyUnsafeNextPageToken . unsafeCoerce + +unsafeFromNextKeyToken :: NextPageToken unique a -> Client (Page a) +unsafeFromNextKeyToken = unsafeCoerce . getNextPage + usersPendingActivationAdd :: MonadClient m => UserPendingActivation -> m () usersPendingActivationAdd (UserPendingActivation uid expiresAt) = do retry x5 . write insertExpiration . params LocalQuorum $ (uid, expiresAt) From 20db50efde7a471ba8c6f017e6a7c922e846ab84 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Sun, 21 Aug 2022 00:13:13 -0700 Subject: [PATCH 07/13] changelog.d --- changelog.d/5-internal/brig-upa-store-effect | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/brig-upa-store-effect diff --git a/changelog.d/5-internal/brig-upa-store-effect b/changelog.d/5-internal/brig-upa-store-effect new file mode 100644 index 00000000000..2c968c67dd3 --- /dev/null +++ b/changelog.d/5-internal/brig-upa-store-effect @@ -0,0 +1 @@ +Brig Polysemy: Port UserPendingActivationStore to polysemy From 6d8bd673d6abeccd225cac6b46ba302b491bc9e3 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 23 Aug 2022 14:22:51 -0700 Subject: [PATCH 08/13] move Galley.Effects.Paging into polysemy-wire-zoo --- .../polysemy-wire-zoo/polysemy-wire-zoo.cabal | 4 ++ .../polysemy-wire-zoo/src/Wire/Sem}/Paging.hs | 2 +- .../src/Wire/Sem/Paging/Cassandra.hs | 38 ++++++++++++-- services/galley/galley.cabal | 3 -- services/galley/src/Galley/API/Internal.hs | 4 +- services/galley/src/Galley/API/LegalHold.hs | 4 +- services/galley/src/Galley/API/Query.hs | 2 +- services/galley/src/Galley/API/Teams.hs | 4 +- .../galley/src/Galley/API/Teams/Features.hs | 4 +- .../src/Galley/Cassandra/ConversationList.hs | 3 +- .../galley/src/Galley/Cassandra/ResultSet.hs | 51 ------------------- services/galley/src/Galley/Cassandra/Team.hs | 3 +- services/galley/src/Galley/Effects.hs | 2 +- .../galley/src/Galley/Effects/ListItems.hs | 2 +- .../Effects/RemoteConversationListStore.hs | 2 +- .../src/Galley/Effects/TeamMemberStore.hs | 2 +- .../galley/src/Galley/Effects/TeamStore.hs | 2 +- stack.yaml.lock | 18 ++++--- 18 files changed, 66 insertions(+), 84 deletions(-) rename {services/galley/src/Galley/Effects => libs/polysemy-wire-zoo/src/Wire/Sem}/Paging.hs (98%) rename services/galley/src/Galley/Cassandra/Paging.hs => libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs (72%) delete mode 100644 services/galley/src/Galley/Cassandra/ResultSet.hs 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..3df80ce5cce 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, @@ -24,8 +24,8 @@ module Galley.Cassandra.Paging mkInternalPage, ipNext, - -- * Re-exports ResultSet, + mkResultSet, resultSetResult, resultSetType, ResultSetType (..), @@ -36,8 +36,7 @@ import Cassandra import Data.Id import Data.Qualified import Data.Range -import Galley.Cassandra.ResultSet -import qualified Galley.Effects.Paging as E +import qualified Wire.Sem.Paging as E import Imports import Wire.API.Team.Member (HardTruncationLimit, TeamMember) @@ -101,3 +100,34 @@ 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..e5420e41419 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -49,7 +49,7 @@ import Galley.API.Teams.Features import qualified Galley.API.Update as Update import Galley.API.Util import Galley.App -import Galley.Cassandra.Paging +import Wire.Sem.Paging.Cassandra import Galley.Cassandra.TeamFeatures import qualified Galley.Data.Conversation as Data import Galley.Effects @@ -59,7 +59,7 @@ import Galley.Effects.FederatorAccess import Galley.Effects.GundeckAccess import Galley.Effects.LegalHoldStore as LegalHoldStore import Galley.Effects.MemberStore -import Galley.Effects.Paging +import Wire.Sem.Paging import Galley.Effects.TeamStore import qualified Galley.Intra.Push as Intra import Galley.Monad diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 88993ec0d45..32fc9de2b89 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -48,13 +48,13 @@ import Galley.API.Error import Galley.API.Query (iterateConversations) import Galley.API.Update (removeMemberFromLocalConv) import Galley.API.Util -import Galley.Cassandra.Paging +import Wire.Sem.Paging.Cassandra 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 Wire.Sem.Paging import qualified Galley.Effects.TeamFeatureStore as TeamFeatures import Galley.Effects.TeamMemberStore import Galley.Effects.TeamStore diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 1e55dbe5d73..35a4d1aa967 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -68,7 +68,7 @@ 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 Wire.Sem.Paging.Cassandra import qualified Galley.Data.Conversation as Data import Galley.Data.Types (Code (codeConversation)) import Galley.Effects diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index d8ad841f396..7c7e7017e6d 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -87,7 +87,7 @@ 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 Wire.Sem.Paging.Cassandra import qualified Galley.Data.Conversation as Data import Galley.Data.Services (BotMember) import Galley.Effects @@ -98,7 +98,7 @@ 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 Wire.Sem.Paging as E import qualified Galley.Effects.Queue as E import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData import qualified Galley.Effects.SparAccess as Spar diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 4085b746fdb..8bd16958e94 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -52,12 +52,12 @@ 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 Wire.Sem.Paging.Cassandra import Galley.Effects import Galley.Effects.BrigAccess (getAccountConferenceCallingConfigClient, updateSearchVisibilityInbound) import Galley.Effects.ConversationStore as ConversationStore import Galley.Effects.GundeckAccess -import Galley.Effects.Paging +import Wire.Sem.Paging import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData import Galley.Effects.TeamFeatureStore import qualified Galley.Effects.TeamFeatureStore as TeamFeatures diff --git a/services/galley/src/Galley/Cassandra/ConversationList.hs b/services/galley/src/Galley/Cassandra/ConversationList.hs index ae8c03eb06f..64150b303a9 100644 --- a/services/galley/src/Galley/Cassandra/ConversationList.hs +++ b/services/galley/src/Galley/Cassandra/ConversationList.hs @@ -27,9 +27,8 @@ import Data.Id import Data.Qualified import Data.Range import Galley.Cassandra.Instances () -import Galley.Cassandra.Paging +import Wire.Sem.Paging.Cassandra import qualified Galley.Cassandra.Queries as Cql -import Galley.Cassandra.ResultSet import Galley.Cassandra.Store import Galley.Effects.ListItems import Imports hiding (max) 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..0f9560ac75a 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -41,9 +41,8 @@ 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 Wire.Sem.Paging.Cassandra import qualified Galley.Cassandra.Queries as Cql -import Galley.Cassandra.ResultSet import Galley.Cassandra.Store import Galley.Effects.ListItems import Galley.Effects.TeamMemberStore diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index ca74c9d98d5..cf1bddc249c 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -62,7 +62,7 @@ where import Data.Id import Data.Qualified import Data.Time.Clock -import Galley.Cassandra.Paging +import Wire.Sem.Paging.Cassandra import Galley.Cassandra.TeamFeatures (Cassandra) import Galley.Effects.BotAccess import Galley.Effects.BrigAccess diff --git a/services/galley/src/Galley/Effects/ListItems.hs b/services/galley/src/Galley/Effects/ListItems.hs index 8853909a1f6..ac44fb02270 100644 --- a/services/galley/src/Galley/Effects/ListItems.hs +++ b/services/galley/src/Galley/Effects/ListItems.hs @@ -24,7 +24,7 @@ module Galley.Effects.ListItems where import Data.Id -import Galley.Effects.Paging +import Wire.Sem.Paging import Imports import Polysemy diff --git a/services/galley/src/Galley/Effects/RemoteConversationListStore.hs b/services/galley/src/Galley/Effects/RemoteConversationListStore.hs index a942f7c6e9f..aae9c9e4d60 100644 --- a/services/galley/src/Galley/Effects/RemoteConversationListStore.hs +++ b/services/galley/src/Galley/Effects/RemoteConversationListStore.hs @@ -26,7 +26,7 @@ where import Data.Id import Data.Qualified -import Galley.Effects.Paging +import Wire.Sem.Paging import Galley.Types.Conversations.Members import Imports import Polysemy diff --git a/services/galley/src/Galley/Effects/TeamMemberStore.hs b/services/galley/src/Galley/Effects/TeamMemberStore.hs index eac886b9463..9a1c0967319 100644 --- a/services/galley/src/Galley/Effects/TeamMemberStore.hs +++ b/services/galley/src/Galley/Effects/TeamMemberStore.hs @@ -27,7 +27,7 @@ module Galley.Effects.TeamMemberStore where import Data.Id -import Galley.Effects.Paging +import Wire.Sem.Paging import Imports import Polysemy import Wire.API.Team.Member diff --git a/services/galley/src/Galley/Effects/TeamStore.hs b/services/galley/src/Galley/Effects/TeamStore.hs index 5441919cca1..ed1afff5504 100644 --- a/services/galley/src/Galley/Effects/TeamStore.hs +++ b/services/galley/src/Galley/Effects/TeamStore.hs @@ -79,7 +79,7 @@ where import Data.Id import Data.Range import Galley.Effects.ListItems -import Galley.Effects.Paging +import Wire.Sem.Paging import Galley.Types.Teams import Galley.Types.Teams.Intra import Imports 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: From 25a27828b172a26237eb90ee36f95ce1dd3be960 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 23 Aug 2022 14:26:13 -0700 Subject: [PATCH 09/13] make format --- libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs | 4 +--- services/galley/src/Galley/API/Internal.hs | 4 ++-- services/galley/src/Galley/API/LegalHold.hs | 4 ++-- services/galley/src/Galley/API/Query.hs | 2 +- services/galley/src/Galley/API/Teams.hs | 4 ++-- services/galley/src/Galley/API/Teams/Features.hs | 4 ++-- services/galley/src/Galley/Cassandra/ConversationList.hs | 2 +- services/galley/src/Galley/Cassandra/Team.hs | 2 +- services/galley/src/Galley/Effects.hs | 2 +- services/galley/src/Galley/Effects/ListItems.hs | 2 +- .../galley/src/Galley/Effects/RemoteConversationListStore.hs | 2 +- services/galley/src/Galley/Effects/TeamMemberStore.hs | 2 +- services/galley/src/Galley/Effects/TeamStore.hs | 2 +- 13 files changed, 17 insertions(+), 19 deletions(-) diff --git a/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs index 3df80ce5cce..ec3efee4fdb 100644 --- a/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs +++ b/libs/polysemy-wire-zoo/src/Wire/Sem/Paging/Cassandra.hs @@ -23,7 +23,6 @@ module Wire.Sem.Paging.Cassandra InternalPagingState (..), mkInternalPage, ipNext, - ResultSet, mkResultSet, resultSetResult, @@ -36,9 +35,9 @@ import Cassandra import Data.Id import Data.Qualified import Data.Range -import qualified Wire.Sem.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,7 +100,6 @@ instance E.Paging InternalPaging where 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. -- diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index e5420e41419..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 Wire.Sem.Paging.Cassandra 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 Wire.Sem.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 32fc9de2b89..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 Wire.Sem.Paging.Cassandra 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 Wire.Sem.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 35a4d1aa967..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 Wire.Sem.Paging.Cassandra 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 7c7e7017e6d..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 Wire.Sem.Paging.Cassandra 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 Wire.Sem.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 8bd16958e94..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 Wire.Sem.Paging.Cassandra import Galley.Effects import Galley.Effects.BrigAccess (getAccountConferenceCallingConfigClient, updateSearchVisibilityInbound) import Galley.Effects.ConversationStore as ConversationStore import Galley.Effects.GundeckAccess -import Wire.Sem.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 64150b303a9..93ae9352d72 100644 --- a/services/galley/src/Galley/Cassandra/ConversationList.hs +++ b/services/galley/src/Galley/Cassandra/ConversationList.hs @@ -27,13 +27,13 @@ import Data.Id import Data.Qualified import Data.Range import Galley.Cassandra.Instances () -import Wire.Sem.Paging.Cassandra import qualified Galley.Cassandra.Queries as Cql 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/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs index 0f9560ac75a..3156f2fc613 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -41,7 +41,6 @@ import Data.UUID.V4 (nextRandom) import qualified Galley.Aws as Aws import qualified Galley.Cassandra.Conversation as C import Galley.Cassandra.LegalHold (isTeamLegalholdWhitelisted) -import Wire.Sem.Paging.Cassandra import qualified Galley.Cassandra.Queries as Cql import Galley.Cassandra.Store import Galley.Effects.ListItems @@ -60,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 cf1bddc249c..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 Wire.Sem.Paging.Cassandra 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 ac44fb02270..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 Wire.Sem.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 aae9c9e4d60..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 Wire.Sem.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 9a1c0967319..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 Wire.Sem.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 ed1afff5504..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 Wire.Sem.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 () From b3a94852d13e0a189a5278bb044d65261c256eba Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 23 Aug 2022 14:26:47 -0700 Subject: [PATCH 10/13] changelog.d --- changelog.d/5-internal/generalized-paging | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/generalized-paging 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 From 6fac30aaf9379cd7d61c4654438e7c9c3661ba7d Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 23 Aug 2022 16:11:12 -0700 Subject: [PATCH 11/13] use paging effect --- services/brig/brig.cabal | 3 +- services/brig/src/Brig/API.hs | 5 +- services/brig/src/Brig/API/Internal.hs | 8 +- services/brig/src/Brig/API/Public.hs | 6 +- services/brig/src/Brig/API/User.hs | 6 +- .../brig/src/Brig/CanonicalInterpreter.hs | 3 +- services/brig/src/Brig/Run.hs | 17 +++-- .../Brig/Sem/UserPendingActivationStore.hs | 76 +++---------------- .../UserPendingActivationStore/Cassandra.hs | 26 ++----- services/brig/src/Brig/Team/API.hs | 6 +- 10 files changed, 44 insertions(+), 112 deletions(-) diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 81158dfd1c6..da83394607d 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -167,7 +167,7 @@ library ghc-options: -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -funbox-strict-fields + -funbox-strict-fields -fplugin=Polysemy.Plugin build-depends: aeson >=2.0.1.0 @@ -240,6 +240,7 @@ library , optparse-applicative >=0.11 , pem >=0.2 , polysemy + , polysemy-plugin , polysemy-wire-zoo , proto-lens >=0.1 , random-shuffle >=0.0.3 diff --git a/services/brig/src/Brig/API.hs b/services/brig/src/Brig/API.hs index 4334ed0f042..5f900f796c3 100644 --- a/services/brig/src/Brig/API.hs +++ b/services/brig/src/Brig/API.hs @@ -33,12 +33,13 @@ import Network.Wai.Routing (Routes) import Polysemy sitemap :: - Members + forall r p. + Members '[ CodeStore, PasswordResetStore, BlacklistStore, BlacklistPhonePrefixStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => Routes Doc.ApiBuilder (Handler r) () diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 8e85731bd3d..b180513c1eb 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -104,7 +104,7 @@ import Wire.API.User.RichInfo servantSitemap :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => ServerT BrigIRoutes.API (Handler r) @@ -135,7 +135,7 @@ mlsAPI = accountAPI :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => ServerT BrigIRoutes.AccountAPI (Handler r) @@ -228,7 +228,7 @@ sitemap :: PasswordResetStore, BlacklistStore, BlacklistPhonePrefixStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => Routes a (Handler r) () @@ -437,7 +437,7 @@ internalListFullClients (UserSet usrs) = createUserNoVerify :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => NewUser -> diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e790bd6bd69..cc4b00a4c9e 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -184,11 +184,11 @@ swaggerDocsAPI (Just V1) = swaggerDocsAPI Nothing = swaggerDocsAPI (Just maxBound) servantSitemap :: - forall r. + forall r p. Members '[ BlacklistStore, BlacklistPhonePrefixStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => ServerT BrigAPI (Handler r) @@ -619,7 +619,7 @@ getClientPrekeys usr clt = lift (wrapClient $ API.lookupPrekeyIds usr clt) createUser :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => Public.NewUserPublic -> diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index db62880f0a5..b34ca706662 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -278,10 +278,10 @@ createUserSpar new = do -- docs/reference/user/registration.md {#RefRegistration} createUser :: - forall r. + forall r p. Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => NewUser -> @@ -523,7 +523,7 @@ initAccountFeatureConfig uid = do createUserInviteViaScim :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => UserId -> diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs index 87261ab82e4..6460a79c42f 100644 --- a/services/brig/src/Brig/CanonicalInterpreter.hs +++ b/services/brig/src/Brig/CanonicalInterpreter.hs @@ -17,12 +17,13 @@ import Imports import Polysemy (Embed, Final, embedToFinal, runFinal) import Wire.Sem.Now (Now) import Wire.Sem.Now.IO (nowToIOAction) +import Wire.Sem.Paging.Cassandra (InternalPaging) type BrigCanonicalEffects = '[ BlacklistPhonePrefixStore, BlacklistStore, PasswordResetStore, - UserPendingActivationStore, + UserPendingActivationStore InternalPaging, Now, CodeStore, Embed Cas.Client, diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index d202499f2cd..d771fc60133 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -40,7 +40,7 @@ import qualified Brig.InternalEvent.Process as Internal import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Queue as Queue import Brig.Sem.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) -import qualified Brig.Sem.UserPendingActivationStore as E +import qualified Wire.Sem.Paging as P import qualified Brig.Sem.UserPendingActivationStore as UsersPendingActivationStore import Brig.Types.Intra (AccountStatus (PendingInvitation)) import Brig.Version @@ -182,7 +182,7 @@ bodyParserErrorFormatter _ _ errMsg = Servant.errHeaders = [(HTTP.hContentType, HTTPMedia.renderHeader (Servant.contentType (Proxy @Servant.JSON)))] } -pendingActivationCleanup :: forall r. Members '[UserPendingActivationStore] r => AppT r () +pendingActivationCleanup :: forall r p. (P.Paging p, Members '[UserPendingActivationStore p] r) => AppT r () pendingActivationCleanup = do safeForever "pendingActivationCleanup" $ do now <- liftIO =<< view currentTime @@ -220,13 +220,13 @@ pendingActivationCleanup = do forExpirationsPaged :: ([UserPendingActivation] -> (AppT r) ()) -> (AppT r) () forExpirationsPaged f = do - go =<< liftSem UsersPendingActivationStore.list + go =<< liftSem (UsersPendingActivationStore.list Nothing) where - -- go :: E.Page _ UserPendingActivation -> (AppT r) () - go (E.Page result maybeNextPageKey) = do - f result - for_ maybeNextPageKey $ \key -> - go =<< liftSem (UsersPendingActivationStore.getNext key) + go :: P.Page p UserPendingActivation -> (AppT r) () + go p = do + f (P.pageItems p) + when (P.pageHasMore p) $ do + go =<< liftSem (UsersPendingActivationStore.list $ Just $ P.pageState p) threadDelayRandom :: (AppT r) () threadDelayRandom = do @@ -238,6 +238,7 @@ pendingActivationCleanup = do hours :: Double -> Timeout hours n = realToFrac (n * 60 * 60) + collectAuthMetrics :: forall r. AppT r () collectAuthMetrics = do m <- view metrics diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs index 3fa9339d2c7..e32f208cc7a 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs @@ -1,13 +1,12 @@ -{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE TemplateHaskell #-} module Brig.Sem.UserPendingActivationStore where import Data.Id import Data.Time.Clock -import GHC.Exts (Any) -import Imports hiding (Any) +import Imports import Polysemy +import Wire.Sem.Paging data UserPendingActivation = UserPendingActivation { upaUserId :: !UserId, @@ -15,70 +14,15 @@ data UserPendingActivation = UserPendingActivation } deriving stock (Eq, Show, Ord) --- | A backend-independent paging mechanism, with immediate results and --- possibly a 'NextPageToken' which can be used by 'getNext' to load the next --- page. -data Page m a = Page - { results :: [a], - nextPageToken :: Maybe (NextPageToken m a) - } - -type role Page nominal nominal - --- | An interpretation-specific means of performign paging. In an ideal world, --- paging could just return a @ConduitT () o (Sem r) ()@, but this thing is --- impossible to implement given the available polysemy tools --- at least, --- without forcing the entire stream immediately. --- --- Instead, we're left needing to pump the paging mechanism ourselves, see the --- 'getNext' action. This would be fine, except that different interpretations --- are going to require different types of state to implement their paging. --- A type family would be ideal here, but unfortunately we can't attach type --- instances to *interpretations*. --- --- So instead we do a dirty, awful thing where we use 'Any' and just --- 'Unsafe.Coerce.unsafeCoece' to and from it. I know. I'm sorry. --- Interpretations are responsible for consistently coercing 'getNextPage'. --- --- Despite all of this, it's not as horrible as it sounds. Assuming the --- interpreter is consistent in its usage, we are protected by three things: --- --- 1. The 'NextPageToken' itself is well-typed with respect to what it can --- produce. It has nominal roles to ensure users can't break the invariants. --- --- 2. The @m@ type variable is used for the ST-trick, where we tie it to the --- same monadic context in which polysemy is running its effects. Thus we --- are guaranteed that the only 'NextPageToken' that will typecheck when --- passed to 'getNext' actually came from a corresponding call to 'list' --- _within the same interpretation._ --- --- 3. There is a WARNING pragma attached to the data constructor, meaning any --- user who attempts to build one will get yelled at. Unfortunately, we need --- to expose a means of constructing this type so interpreter authors can --- use it, but a WARNING is the next best thing. --- --- Interpretation authors may use @-fno-warn-deprecations@ to disable this --- WARNING. -data NextPageToken m a = ExtremelyUnsafeNextPageToken - { getNextPage :: Any - } - -type role NextPageToken nominal nominal - -{-# WARNING - ExtremelyUnsafeNextPageToken - "Under NO CIRCUMSTANCES should you construct a NextPageToken in application code. \ - \If you are implementing an interpreter, read the haddocks on NextPageToken for \ - \information on what to do and how to turn off this warning." - #-} - -data UserPendingActivationStore m a where - Add :: UserPendingActivation -> UserPendingActivationStore m () - List :: UserPendingActivationStore m (Page m UserPendingActivation) - GetNext :: NextPageToken m UserPendingActivation -> UserPendingActivationStore m (Page m UserPendingActivation) - RemoveMultiple :: [UserId] -> UserPendingActivationStore m () +data UserPendingActivationStore p m a where + Add :: UserPendingActivation -> UserPendingActivationStore p m () + List + :: Maybe (PagingState p UserPendingActivation) + -> UserPendingActivationStore p m (Page p UserPendingActivation) + RemoveMultiple :: [UserId] -> UserPendingActivationStore p m () makeSem ''UserPendingActivationStore -remove :: Member UserPendingActivationStore r => UserId -> Sem r () +remove :: forall p r. Member (UserPendingActivationStore p) r => UserId -> Sem r () remove uid = removeMultiple [uid] + diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs index d9f6637c9be..9521af20d44 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore/Cassandra.hs @@ -1,46 +1,30 @@ --- See note on 'NextPageToken' -{-# OPTIONS_GHC -fno-warn-deprecations #-} - module Brig.Sem.UserPendingActivationStore.Cassandra ( userPendingActivationStoreToCassandra, ) where -import Brig.Sem.UserPendingActivationStore hiding (Page) -import qualified Brig.Sem.UserPendingActivationStore as E +import Brig.Sem.UserPendingActivationStore import Cassandra import Data.Id (UserId) import Data.Time (UTCTime) import Imports import Polysemy import Polysemy.Internal.Tactics -import Unsafe.Coerce (unsafeCoerce) +import qualified Wire.Sem.Paging.Cassandra as PC userPendingActivationStoreToCassandra :: forall r a. (Member (Embed Client) r) => - Sem (UserPendingActivationStore ': r) a -> + Sem (UserPendingActivationStore PC.InternalPaging ': r) a -> Sem r a userPendingActivationStoreToCassandra = interpretH $ liftT . embed @Client . \case Add upa -> usersPendingActivationAdd upa - List -> - fmap cassandraPageToEffectPage $ usersPendingActivationList - GetNext nkt -> - fmap cassandraPageToEffectPage $ unsafeFromNextKeyToken nkt + List Nothing -> (flip PC.mkInternalPage pure) =<< usersPendingActivationList + List (Just ps) -> PC.ipNext ps RemoveMultiple uids -> usersPendingActivationRemoveMultiple uids -cassandraPageToEffectPage :: Page a -> E.Page unique a -cassandraPageToEffectPage (Page more results nextPage) = - E.Page results $ bool Nothing (Just $ unsafeToNextKeyToken nextPage) more - -unsafeToNextKeyToken :: Client (Page a) -> NextPageToken unique a -unsafeToNextKeyToken = ExtremelyUnsafeNextPageToken . unsafeCoerce - -unsafeFromNextKeyToken :: NextPageToken unique a -> Client (Page a) -unsafeFromNextKeyToken = unsafeCoerce . getNextPage - usersPendingActivationAdd :: MonadClient m => UserPendingActivation -> m () usersPendingActivationAdd (UserPendingActivation uid expiresAt) = do retry x5 . write insertExpiration . params LocalQuorum $ (uid, expiresAt) diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 43620874864..9afa8b0a361 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -192,7 +192,7 @@ routesPublic = do routesInternal :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => Routes a (Handler r) () @@ -290,7 +290,7 @@ createInvitationPublic uid tid body = do createInvitationViaScimH :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => JSON ::: JsonRequest NewUserScimInvitation -> @@ -302,7 +302,7 @@ createInvitationViaScimH (_ ::: req) = do createInvitationViaScim :: Members '[ BlacklistStore, - UserPendingActivationStore + UserPendingActivationStore p ] r => NewUserScimInvitation -> From a84819ba53ca847c225f66470625f5d476a79768 Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Tue, 23 Aug 2022 16:13:46 -0700 Subject: [PATCH 12/13] make format --- services/brig/src/Brig/API.hs | 2 +- services/brig/src/Brig/Run.hs | 3 +-- services/brig/src/Brig/Sem/UserPendingActivationStore.hs | 7 +++---- 3 files changed, 5 insertions(+), 7 deletions(-) diff --git a/services/brig/src/Brig/API.hs b/services/brig/src/Brig/API.hs index 5f900f796c3..d724135c50f 100644 --- a/services/brig/src/Brig/API.hs +++ b/services/brig/src/Brig/API.hs @@ -34,7 +34,7 @@ import Polysemy sitemap :: forall r p. - Members + Members '[ CodeStore, PasswordResetStore, BlacklistStore, diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index d771fc60133..8a5eba0a1c3 100644 --- a/services/brig/src/Brig/Run.hs +++ b/services/brig/src/Brig/Run.hs @@ -40,7 +40,6 @@ import qualified Brig.InternalEvent.Process as Internal import Brig.Options hiding (internalEvents, sesQueue) import qualified Brig.Queue as Queue import Brig.Sem.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore) -import qualified Wire.Sem.Paging as P import qualified Brig.Sem.UserPendingActivationStore as UsersPendingActivationStore import Brig.Types.Intra (AccountStatus (PendingInvitation)) import Brig.Version @@ -78,6 +77,7 @@ import Wire.API.Routes.API import Wire.API.Routes.Public.Brig import Wire.API.Routes.Version import Wire.API.Routes.Version.Wai +import qualified Wire.Sem.Paging as P -- FUTUREWORK: If any of these async threads die, we will have no clue about it -- and brig could start misbehaving. We should ensure that brig dies whenever a @@ -238,7 +238,6 @@ pendingActivationCleanup = do hours :: Double -> Timeout hours n = realToFrac (n * 60 * 60) - collectAuthMetrics :: forall r. AppT r () collectAuthMetrics = do m <- view metrics diff --git a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs index e32f208cc7a..a23f1d5a878 100644 --- a/services/brig/src/Brig/Sem/UserPendingActivationStore.hs +++ b/services/brig/src/Brig/Sem/UserPendingActivationStore.hs @@ -16,13 +16,12 @@ data UserPendingActivation = UserPendingActivation data UserPendingActivationStore p m a where Add :: UserPendingActivation -> UserPendingActivationStore p m () - List - :: Maybe (PagingState p UserPendingActivation) - -> UserPendingActivationStore p m (Page p UserPendingActivation) + List :: + Maybe (PagingState p UserPendingActivation) -> + UserPendingActivationStore p m (Page p UserPendingActivation) RemoveMultiple :: [UserId] -> UserPendingActivationStore p m () makeSem ''UserPendingActivationStore remove :: forall p r. Member (UserPendingActivationStore p) r => UserId -> Sem r () remove uid = removeMultiple [uid] - From 0877200022454d43432a9933a7ba065909a676ee Mon Sep 17 00:00:00 2001 From: Sandy Maguire Date: Thu, 25 Aug 2022 09:27:11 -0700 Subject: [PATCH 13/13] fix integration tests --- services/brig/brig.cabal | 1 + services/brig/test/integration/Main.hs | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 548d4bbe7df..70cf4076c81 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -543,6 +543,7 @@ executable brig-integration , optparse-applicative , pem , polysemy + , polysemy-wire-zoo , process , proto-lens , QuickCheck diff --git a/services/brig/test/integration/Main.hs b/services/brig/test/integration/Main.hs index 7321ee93d3c..3e51716247c 100644 --- a/services/brig/test/integration/Main.hs +++ b/services/brig/test/integration/Main.hs @@ -61,6 +61,7 @@ import Util import Util.Options import Util.Test import Wire.API.Federation.API +import Wire.Sem.Paging.Cassandra (InternalPaging) data BackendConf = BackendConf { remoteBrig :: Endpoint, @@ -157,7 +158,7 @@ runTests iConf brigOpts otherArgs = do assertEqual "inconcistent sitemap" mempty - (pathsConsistencyCheck . treeToPaths . compile $ Brig.API.sitemap @BrigCanonicalEffects), + (pathsConsistencyCheck . treeToPaths . compile $ Brig.API.sitemap @BrigCanonicalEffects @InternalPaging), userApi, providerApi, searchApis,