[WPB-23806] (Un-)suspend apps if en-/disabled in the team.

changelog.d/3-bug-fixes/WPB-23806-_un-_suspend-apps-if-en-_disabled-in-the-team

@@ -0,0 +1 @@
+(Un-)suspend apps if en-/disabled in the team.

integration/test/Test/FeatureFlags/Apps.hs

@@ -17,6 +17,8 @@
 
 module Test.FeatureFlags.Apps where
 
+import API.Brig (NewApp (..), createApp)
+import qualified API.BrigInternal as BrigI
 import qualified API.GalleyInternal as Internal
 import SetupHelpers
 import Test.FeatureFlags.Util
@@ -40,3 +42,51 @@ testAppsInternal = do
 
 testPatchApps :: (HasCallStack) => App ()
 testPatchApps = checkPatch OwnDomain "apps" disabled
+
+-- | Disabling the apps feature for a team suspends all app users in that team.
+-- Re-enabling it restores them to active.  Regular team members are unaffected.
+testAppsSuspendOnDisable :: (HasCallStack) => App ()
+testAppsSuspendOnDisable = do
+  (owner, tid, [regularMember]) <- createTeam OwnDomain 2
+  Internal.setTeamFeatureLockStatus owner tid "apps" "unlocked"
+
+  -- Create an app user in the team
+  app <-
+    let newApp =
+          NewApp
+            { name = "poll-app",
+              assets = Nothing,
+              accentId = Nothing,
+              category = "other",
+              description = "also other"
+            }
+     in bindResponse (createApp owner tid newApp) $ \resp -> do
+          resp.status `shouldMatchInt` 200
+          resp.json %. "user"
+
+  -- Verify initial account statuses are active
+  BrigI.getAccountStatus app `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "active"
+  BrigI.getAccountStatus regularMember `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "active"
+
+  -- Disable the apps feature: app users should be suspended
+  setFeature InternalAPI owner tid "apps" disabled >>= assertSuccess
+
+  BrigI.getAccountStatus app `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "suspended"
+
+  -- Regular member must NOT be suspended
+  BrigI.getAccountStatus regularMember `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "active"
+
+  -- Re-enable the apps feature: app users should be active again
+  setFeature InternalAPI owner tid "apps" enabled >>= assertSuccess
+
+  BrigI.getAccountStatus app `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "active"

libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs

@@ -724,6 +724,7 @@ type API =
            :<|> EnterpriseLoginApi
            :<|> SAMLIdPAPI
            :<|> DeleteApp
+           :<|> GetAppIds
        )
 
 type SAMLIdPAPI =
@@ -747,6 +748,15 @@ type DeleteApp =
         :> Delete '[Servant.JSON] NoContent
     )
 
+type GetAppIds =
+  Named
+    "i-get-app-ids"
+    ( "teams"
+        :> Capture "tid" TeamId
+        :> "apps"
+        :> Get '[Servant.JSON] [UserId]
+    )
+
 type IStatusAPI =
   Named
     "get-status"

libs/wire-subsystems/src/Wire/BrigAPIAccess.hs

@@ -62,6 +62,7 @@ module Wire.BrigAPIAccess
 
     -- * Bots
     deleteBot,
+    getAppIdsForTeam,
 
     -- * User Groups
     createGroupInternal,
@@ -71,6 +72,9 @@ module Wire.BrigAPIAccess
     deleteGroupInternal,
     deleteApp,
     DeleteGroupManagedError (..),
+
+    -- * Account status
+    setAccountStatus,
   )
 where
 
@@ -170,6 +174,8 @@ data BrigAPIAccess m a where
   UpdateGroup :: UpdateGroupInternalRequest -> BrigAPIAccess m (Either Wai.Error ())
   DeleteGroupInternal :: ManagedBy -> TeamId -> UserGroupId -> BrigAPIAccess m (Either DeleteGroupManagedError ())
   DeleteApp :: TeamId -> UserId -> BrigAPIAccess m ()
+  GetAppIdsForTeam :: TeamId -> BrigAPIAccess m [UserId]
+  SetAccountStatus :: UserId -> AccountStatus -> BrigAPIAccess m ()
 
 makeSem ''BrigAPIAccess
 

libs/wire-subsystems/src/Wire/BrigAPIAccess/Rpc.hs

@@ -53,7 +53,7 @@ import Wire.API.Team.Export
 import Wire.API.Team.Feature
 import Wire.API.Team.LegalHold.Internal
 import Wire.API.Team.Size
-import Wire.API.User (EmailAddress, UpdateConnectionsInternal, User, UserIds (..), UserSet (..))
+import Wire.API.User (AccountStatus (..), AccountStatusUpdate (..), EmailAddress, UpdateConnectionsInternal, User, UserIds (..), UserSet (..))
 import Wire.API.User.Auth.LegalHold
 import Wire.API.User.Auth.ReAuth
 import Wire.API.User.Client
@@ -138,6 +138,10 @@ interpretBrigAccess brigEndpoint =
         deleteGroupInternal managedBy teamId groupId
       DeleteApp teamId userId ->
         deleteApp teamId userId
+      GetAppIdsForTeam teamId ->
+        getAppIdsForTeam teamId
+      SetAccountStatus uid status ->
+        setAccountStatus uid status
 
 brigRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString))
 brigRequest req = do
@@ -716,6 +720,31 @@ deleteApp teamId userId = do
         . paths ["i", "teams", toByteString' teamId, "apps", toByteString' userId]
         . expect2xx
 
+getAppIdsForTeam ::
+  (Member Rpc r, Member (Input Endpoint) r) =>
+  TeamId ->
+  Sem r [UserId]
+getAppIdsForTeam teamId = do
+  resp <-
+    brigRequest $
+      method GET
+        . paths ["i", "teams", toByteString' teamId, "apps"]
+        . expect2xx
+  pure . fromMaybe [] . responseJsonMaybe $ resp
+
+setAccountStatus ::
+  (Member Rpc r, Member (Input Endpoint) r) =>
+  UserId ->
+  AccountStatus ->
+  Sem r ()
+setAccountStatus uid status =
+  void $
+    brigRequest $
+      method PUT
+        . paths ["i", "users", toByteString' uid, "status"]
+        . json (AccountStatusUpdate status)
+        . expect2xx
+
 is2xx :: ResponseLBS -> Bool
 is2xx = statusIs2xx . statusCode
 

libs/wire-subsystems/src/Wire/UserSubsystem.hs

@@ -118,22 +118,6 @@ data ChangeEmailResult
     ChangeEmailIdempotent
   deriving (Show)
 
-data UserProfileFilter
-  = AppsFromTeamOnly TeamId
-  | RegularPlusAllApps
-  deriving (Eq, Show)
-
-runUserProfileFilter :: UserProfileFilter -> UserProfile -> Bool
-runUserProfileFilter upf prof = case upf of
-  AppsFromTeamOnly tid -> case prof.profileType of
-    UserTypeRegular -> False
-    UserTypeApp -> prof.profileTeam == Just tid
-    UserTypeBot -> False -- bots aren't in the picture
-  RegularPlusAllApps -> case prof.profileType of
-    UserTypeRegular -> True
-    UserTypeApp -> True
-    UserTypeBot -> True
-
 data UserSubsystem m a where
   -- | First arg is for authorization only.
   GetUserProfiles :: Local UserId -> [Qualified UserId] -> UserSubsystem m [UserProfile]
@@ -144,7 +128,9 @@ data UserSubsystem m a where
   -- FederationError)], [UserProfile])` to maintain API compatibility.)
   GetUserProfilesWithErrors :: Local UserId -> [Qualified UserId] -> UserSubsystem m ([(Qualified UserId, FederationError)], [UserProfile])
   -- | Sometimes we don't have any identity of a requesting user, and local profiles are public.
-  GetLocalUserProfilesFiltered :: UserProfileFilter -> Local [UserId] -> UserSubsystem m [UserProfile]
+  GetLocalUserProfiles :: Local [UserId] -> UserSubsystem m [UserProfile]
+  -- | Get profiles for all app users in a team, touching only the apps table (efficient).
+  GetLocalAppProfilesOnly :: Local TeamId -> UserSubsystem m [UserProfile]
   -- | Get the union of all user accounts matching the `GetBy` argument *and* having a non-empty UserIdentity.
   GetAccountsBy :: Local GetBy -> UserSubsystem m [User]
   -- | Get user accounts matching the `[EmailAddress]` argument (accounts with missing
@@ -221,25 +207,6 @@ getLocalUserProfile ::
 getLocalUserProfile targetUser =
   listToMaybe <$> getLocalUserProfiles ((: []) <$> targetUser)
 
-getLocalUserProfileFiltered ::
-  (Member UserSubsystem r) =>
-  UserProfileFilter -> Local UserId -> Sem r (Maybe UserProfile)
-getLocalUserProfileFiltered upf targetUser =
-  listToMaybe <$> getLocalUserProfilesFiltered upf ((: []) <$> targetUser)
-
-getLocalUserProfileFiltered404 ::
-  (Member (Error UserSubsystemError) r, Member UserSubsystem r) =>
-  UserProfileFilter -> Local UserId -> Sem r UserProfile
-getLocalUserProfileFiltered404 upf targetUser =
-  getLocalUserProfileFiltered upf targetUser >>= note UserSubsystemProfileNotFound
-
-getLocalUserProfiles ::
-  (Member UserSubsystem r) =>
-  Local [UserId] ->
-  Sem r [UserProfile]
-getLocalUserProfiles =
-  getLocalUserProfilesFiltered RegularPlusAllApps
-
 getLocalAccountBy ::
   (Member UserSubsystem r) =>
   HavePendingInvitations ->

libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs

@@ -71,6 +71,8 @@ import Wire.API.User as User
 import Wire.API.User.RichInfo
 import Wire.API.User.Search
 import Wire.API.UserEvent
+import Wire.AppStore (AppStore)
+import Wire.AppStore qualified as AppStore
 import Wire.AppSubsystem
 import Wire.AuthenticationSubsystem
 import Wire.BlockListStore as BlockList
@@ -107,7 +109,8 @@ import Wire.UserSubsystem.UserSubsystemConfig
 import Witherable (wither)
 
 runUserSubsystem ::
-  ( Member UserStore r,
+  ( Member AppStore r,
+    Member UserStore r,
     Member UserKeyStore r,
     Member GalleyAPIAccess r,
     Member BlockListStore r,
@@ -142,8 +145,10 @@ runUserSubsystem authInterpreter appInterpreter clientInterpreter =
     clientInterpreter . appInterpreter . authInterpreter . \case
       GetUserProfiles self others ->
         getUserProfilesImpl self others
-      GetLocalUserProfilesFiltered upf others ->
-        getLocalUserProfilesFilteredImpl upf others
+      GetLocalUserProfiles others ->
+        getLocalUserProfilesImpl others
+      GetLocalAppProfilesOnly ltid ->
+        getLocalAppProfilesOnlyImpl ltid
       GetAccountsBy getBy ->
         getAccountsByImpl getBy
       GetAccountsByEmailNoFilter emails ->
@@ -345,7 +350,7 @@ getUserProfilesImpl self others =
       (getUserProfilesFromDomain self)
       (bucketQualified others)
 
-getLocalUserProfilesFilteredImpl ::
+getLocalUserProfilesImpl ::
   forall r any.
   ( Member UserStore r,
     Member (Input UserSubsystemConfig) r,
@@ -356,10 +361,27 @@ getLocalUserProfilesFilteredImpl ::
     Member TeamSubsystem r,
     Member AppSubsystem r
   ) =>
-  UserProfileFilter ->
   Local [UserId] ->
   Sem r [UserProfile]
-getLocalUserProfilesFilteredImpl upf = getUserProfilesLocalPart upf Nothing
+getLocalUserProfilesImpl = getUserProfilesLocalPart Nothing
+
+getLocalAppProfilesOnlyImpl ::
+  forall r any.
+  ( Member AppStore r,
+    Member UserStore r,
+    Member (Input UserSubsystemConfig) r,
+    Member DeleteQueue r,
+    Member Now r,
+    Member (Concurrency Unsafe) r,
+    Member (Input (Local any)) r,
+    Member AppSubsystem r,
+    Member TeamSubsystem r
+  ) =>
+  Local TeamId ->
+  Sem r [UserProfile]
+getLocalAppProfilesOnlyImpl ltid = do
+  appIds <- map (.id) <$> AppStore.getApps (tUnqualified ltid)
+  getUserProfilesLocalPart Nothing (ltid $> appIds)
 
 getUserProfilesFromDomain ::
   ( Member (Error FederationError) r,
@@ -382,7 +404,7 @@ getUserProfilesFromDomain ::
 getUserProfilesFromDomain self uids = do
   foldQualified
     self
-    (getUserProfilesLocalPart RegularPlusAllApps (Just self))
+    (getUserProfilesLocalPart (Just self))
     getUserProfilesRemotePart
     uids
 
@@ -409,11 +431,10 @@ getUserProfilesLocalPart ::
     Member AppSubsystem r,
     Member TeamSubsystem r
   ) =>
-  UserProfileFilter ->
   Maybe (Local UserId) ->
   Local [UserId] ->
   Sem r [UserProfile]
-getUserProfilesLocalPart upf requestingUser luids = do
+getUserProfilesLocalPart requestingUser luids = do
   emailVisibilityConfig <- inputs emailVisibilityConfig
   requestingUserInfo <- join <$> traverse getRequestingUserInfo requestingUser
   let canSeeEmails = maybe False (isAdminOrOwner . view (newTeamMember . nPermissions) . snd) requestingUserInfo
@@ -422,14 +443,11 @@ getUserProfilesLocalPart upf requestingUser luids = do
         EmailVisibleToSelf -> EmailVisibleToSelf
         EmailVisibleIfOnTeam -> EmailVisibleIfOnTeam
         EmailVisibleIfOnSameTeam () -> EmailVisibleIfOnSameTeam requestingUserInfo
-  fmap filterAppsFromOtherTeams . injectAppsIntoUserProfiles . catMaybes
+  injectAppsIntoUserProfiles . catMaybes
     -- FUTUREWORK: (in the interpreters where it makes sense) pull paginated lists from the DB,
     -- not just single rows.
     =<< unsafePooledForConcurrentlyN 8 (sequence luids) (getLocalUserProfileInternal emailVisibilityConfigWithViewer)
   where
-    filterAppsFromOtherTeams :: [UserProfile] -> [UserProfile]
-    filterAppsFromOtherTeams = filter (runUserProfileFilter upf)
-
     getRequestingUserInfo :: Local UserId -> Sem r (Maybe (TeamId, TeamMember))
     getRequestingUserInfo self = do
       -- FUTUREWORK: it is an internal error for the two lookups (for 'User' and 'TeamMember')

libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserSubsystem.hs

@@ -65,11 +65,11 @@ inMemoryUserSubsystemInterpreter =
     IsBlocked _ -> pure False
     GetUserProfiles _ _ -> error "GetUserProfiles: implement on demand (userSubsystemInterpreter)"
     GetUserProfilesWithErrors _ _ -> error "GetUserProfilesWithErrors: implement on demand (userSubsystemInterpreter)"
-    GetLocalUserProfilesFiltered upf luids ->
-      filter (runUserProfileFilter upf)
-        <$> ( toProfile . mkUserFromStored testDomain testLocale
-                <$$> UserStore.getUsers (tUnqualified luids)
-            )
+    GetLocalUserProfiles luids ->
+      toProfile . mkUserFromStored testDomain testLocale
+        <$$> UserStore.getUsers (tUnqualified luids)
+    GetLocalAppProfilesOnly _ ->
+      error "GetLocalAppProfilesOnly: implement on demand (userSubsystemInterpreter)"
     GetAccountsBy (tUnqualified -> GetBy NoPendingInvitations True True uids []) ->
       mkUserFromStored testDomain testLocale <$$> UserStore.getUsers uids
     GetAccountsBy (tUnqualified -> GetBy _ _ _ uids []) ->

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

@@ -90,6 +90,8 @@ import Wire.API.UserGroup (UserGroup)
 import Wire.API.UserGroup.Pagination
 import Wire.API.UserMap
 import Wire.ActivationCodeStore (ActivationCodeStore)
+import Wire.AppStore (AppStore)
+import Wire.AppStore qualified as AppStore
 import Wire.AppSubsystem (AppSubsystem)
 import Wire.AppSubsystem qualified as AppSubsystem
 import Wire.AuthenticationSubsystem (AuthenticationSubsystem)
@@ -181,6 +183,7 @@ servantSitemap ::
     Member CryptoSign r,
     Member Random r,
     Member SAMLEmailSubsystem r,
+    Member AppStore r,
     Member AppSubsystem r,
     Member ClientStore r,
     Member ClientSubsystem r
@@ -203,6 +206,7 @@ servantSitemap =
     :<|> enterpriseLoginApi
     :<|> samlIdPApi
     :<|> Named @"i-delete-app" deleteAppH
+    :<|> Named @"i-get-app-ids" getAppIdsH
 
 istatusAPI :: forall r. ServerT BrigIRoutes.IStatusAPI (Handler r)
 istatusAPI = Named @"get-status" (pure NoContent)
@@ -1046,3 +1050,6 @@ deleteGroupManagedInternalH tid gid managedBy = do
 
 deleteAppH :: (Member AppSubsystem r) => TeamId -> UserId -> Handler r NoContent
 deleteAppH tid uid = lift . liftSem $ AppSubsystem.deleteApp tid uid >> pure NoContent
+
+getAppIdsH :: (Member AppStore r) => TeamId -> Handler r [UserId]
+getAppIdsH tid = lift . liftSem $ map (.id) <$> AppStore.getApps tid