Brig Polysemy: Port UserPendingActivationStore to polysemy

changelog.d/5-internal/brig-upa-store-effect

@@ -0,0 +1 @@
+Brig Polysemy: Port UserPendingActivationStore to polysemy

services/brig/brig.cabal

@@ -54,7 +54,6 @@ library
     Brig.Data.Types
     Brig.Data.User
     Brig.Data.UserKey
-    Brig.Data.UserPendingActivation
     Brig.Effects.BlacklistPhonePrefixStore
     Brig.Effects.BlacklistPhonePrefixStore.Cassandra
     Brig.Effects.BlacklistStore
@@ -90,6 +89,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
@@ -167,7 +168,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 +241,7 @@ library
     , optparse-applicative       >=0.11
     , pem                        >=0.2
     , polysemy
+    , polysemy-plugin
     , polysemy-wire-zoo
     , proto-lens                 >=0.1
     , random-shuffle             >=0.0.3

services/brig/src/Brig/API.hs

@@ -27,16 +27,19 @@ 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
 
 sitemap ::
+  forall r p.
   Members
     '[ CodeStore,
        PasswordResetStore,
        BlacklistStore,
-       BlacklistPhonePrefixStore
+       BlacklistPhonePrefixStore,
+       UserPendingActivationStore p
      ]
     r =>
   Routes Doc.ApiBuilder (Handler r) ()

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 p
+     ]
+    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 p
+     ]
+    r =>
+  ServerT BrigIRoutes.AccountAPI (Handler r)
 accountAPI =
   Named @"createUserNoVerify" createUserNoVerify
     :<|> Named @"createUserNoVerifySpar" createUserNoVerifySpar
@@ -214,7 +227,8 @@ sitemap ::
     '[ CodeStore,
        PasswordResetStore,
        BlacklistStore,
-       BlacklistPhonePrefixStore
+       BlacklistPhonePrefixStore,
+       UserPendingActivationStore p
      ]
     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 p
+     ]
+    r =>
+  NewUser ->
+  (Handler r) (Either RegisterError SelfProfile)
 createUserNoVerify uData = lift . runExceptT $ do
   result <- API.createUser uData
   let acc = createdAccount result

services/brig/src/Brig/API/Public.hs

@@ -51,6 +51,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)
@@ -185,10 +186,11 @@ swaggerDocsAPI (Just V1) =
 swaggerDocsAPI Nothing = swaggerDocsAPI (Just maxBound)
 
 servantSitemap ::
-  forall r.
+  forall r p.
   Members
     '[ BlacklistStore,
-       BlacklistPhonePrefixStore
+       BlacklistPhonePrefixStore,
+       UserPendingActivationStore p
      ]
     r =>
   ServerT BrigAPI (Handler r)
@@ -625,7 +627,14 @@ newNonce _ = do
   pure nonce
 
 -- | docs/reference/user/registration.md {#RefRegistration}
-createUser :: Member BlacklistStore r => Public.NewUserPublic -> (Handler r) (Either Public.RegisterError Public.RegisterSuccess)
+createUser ::
+  Members
+    '[ BlacklistStore,
+       UserPendingActivationStore p
+     ]
+    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

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 p.
+  Members
+    '[ BlacklistStore,
+       UserPendingActivationStore p
+     ]
+    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 p
+     ]
+    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'

services/brig/src/Brig/CanonicalInterpreter.hs

@@ -9,17 +9,21 @@ 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
 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 InternalPaging,
      Now,
      CodeStore,
      Embed Cas.Client,
@@ -34,6 +38,7 @@ runBrigToIO e (AppT ma) =
     . interpretClientToIO (e ^. casClient)
     . codeStoreToCassandra @Cas.Client
     . nowToIOAction (e ^. currentTime)
+    . userPendingActivationStoreToCassandra
     . passwordResetStoreToCodeStore
     . interpretBlacklistStoreToCassandra @Cas.Client
     . interpretBlacklistPhonePrefixStoreToCassandra @Cas.Client

services/brig/src/Brig/Run.hs

@@ -36,13 +36,13 @@ 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))
 import qualified Control.Concurrent.Async as Async
 import Control.Exception.Safe (catchAny)
 import Control.Lens (view, (.~), (^.))
@@ -67,6 +67,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, (.=), (~~))
@@ -76,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
@@ -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 p. (P.Paging p, Members '[UserPendingActivationStore p] 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,13 +220,13 @@ pendingActivationCleanup = do
 
     forExpirationsPaged :: ([UserPendingActivation] -> (AppT r) ()) -> (AppT r) ()
     forExpirationsPaged f = do
-      go =<< wrapClient usersPendingActivationList
+      go =<< liftSem (UsersPendingActivationStore.list Nothing)
       where
-        go :: Page UserPendingActivation -> (AppT r) ()
-        go (Page hasMore result nextPage) = do
-          f result
-          when hasMore $
-            go =<< wrapClient (lift nextPage)
+        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