WPB-18187: Delete app when removing a user from a team

changelog.d/3-bug-fixes/WPB-18187

@@ -0,0 +1 @@
+Delete app when removing a user from a team.

integration/test/Test/Apps.hs

@@ -171,3 +171,32 @@ testRefreshAppCookie = do
       resp.json %. "user" `shouldMatch` appId
       resp.json %. "token_type" `shouldMatch` "Bearer"
       resp.json %. "access_token" & asString
+
+testDeleteAppFromTeam :: (HasCallStack) => App ()
+testDeleteAppFromTeam = do
+  domain <- make OwnDomain
+  (owner, tid, _) <- createTeam domain 1
+  let new = def {name = "chappie"} :: NewApp
+  appId <- bindResponse (createApp owner tid new) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "user.id" & asString
+
+  let appIdObject = object ["domain" .= domain, "id" .= appId]
+
+  bindResponse (deleteTeamMember tid owner appIdObject) $ \resp -> do
+    resp.status `shouldMatchInt` 202
+
+  eventually $ do
+    -- Check StoredApp is gone
+    bindResponse (getApp owner tid appId) $ \resp -> do
+      resp.status `shouldMatchInt` 404
+
+    -- Check StoredUser is deleted (via public API)
+    bindResponse (getUser owner appIdObject) $ \resp -> do
+      resp.status `shouldMatchInt` 200
+      resp.json %. "deleted" `shouldMatch` True
+
+    -- Check StoredUser is gone (via internal API)
+    bindResponse (BrigI.getUsersId domain [appId]) $ \resp -> do
+      resp.status `shouldMatchInt` 200
+      resp.json `shouldMatch` ([] :: [Value])

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

@@ -46,6 +46,7 @@ module Wire.API.Routes.Internal.Brig
     FoundInvitationCode (..),
     EnterpriseLoginApi,
     SAMLIdPAPI,
+    DeleteApp,
     IdpChangedNotification (..),
   )
 where
@@ -720,6 +721,7 @@ type API =
            :<|> ProviderAPI
            :<|> EnterpriseLoginApi
            :<|> SAMLIdPAPI
+           :<|> DeleteApp
        )
 
 type SAMLIdPAPI =
@@ -733,6 +735,16 @@ type SAMLIdPAPI =
            )
        )
 
+type DeleteApp =
+  Named
+    "i-delete-app"
+    ( "teams"
+        :> Capture "tid" TeamId
+        :> "apps"
+        :> Capture "uid" UserId
+        :> Delete '[Servant.JSON] NoContent
+    )
+
 type IStatusAPI =
   Named
     "get-status"

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

@@ -65,5 +65,6 @@ data AppStore m a where
   CreateApp :: StoredApp -> AppStore m ()
   GetApp :: UserId -> TeamId -> AppStore m (Maybe StoredApp)
   GetApps :: TeamId -> AppStore m [StoredApp]
+  DeleteApp :: UserId -> TeamId -> AppStore m ()
 
 makeSem ''AppStore

libs/wire-subsystems/src/Wire/AppStore/Postgres.hs

@@ -44,6 +44,7 @@ interpretAppStoreToPostgres =
     CreateApp app -> createAppImpl app
     GetApp userId teamId -> getAppImpl userId teamId
     GetApps teamId -> getAppsImpl teamId
+    DeleteApp userId teamId -> deleteAppImpl userId teamId
 
 createAppImpl ::
   ( Member (Input Pool) r,
@@ -85,3 +86,17 @@ getAppsImpl tid =
     dimapPG
       [vectorStatement| select (user_id :: uuid), (team_id :: uuid), (metadata :: json), (category :: text), (description :: text), (creator :: uuid)
         from apps where team_id = ($1 :: uuid) |]
+
+deleteAppImpl ::
+  ( Member (Input Pool) r,
+    Member (Embed IO) r,
+    Member (Error UsageError) r
+  ) =>
+  UserId ->
+  TeamId ->
+  Sem r ()
+deleteAppImpl uid tid =
+  runStatement (uid, tid) $
+    lmapPG
+      [resultlessStatement|
+        delete from apps where user_id = ($1 :: uuid) and team_id = ($2 :: uuid) |]

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

@@ -58,5 +58,9 @@ data AppSubsystem m a where
     TeamId ->
     UserId ->
     AppSubsystem m (Either RetryAfter SomeUserToken)
+  DeleteApp ::
+    TeamId ->
+    UserId ->
+    AppSubsystem m ()
 
 makeSem ''AppSubsystem

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

@@ -75,6 +75,7 @@ runAppSubsystem = interpret \case
   GetApp lusr tid uid -> getAppImpl lusr tid uid
   GetApps lusr tid -> getAppsImpl lusr tid
   RefreshAppCookie lusr tid appId -> runError $ refreshAppCookieImpl lusr tid appId
+  DeleteApp tid appId -> deleteAppImpl tid appId
 
 createAppImpl ::
   ( Member UserStore r,
@@ -262,3 +263,11 @@ appNewStoredUser creator new = do
 
 defAppSupportedProtocols :: Set BaseProtocolTag
 defAppSupportedProtocols = Set.singleton BaseProtocolMLSTag
+
+deleteAppImpl ::
+  (Member AppStore r) =>
+  TeamId ->
+  UserId ->
+  Sem r ()
+deleteAppImpl teamId appId =
+  Store.deleteApp appId teamId

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

@@ -69,6 +69,7 @@ module Wire.BrigAPIAccess
     getGroupsInternal,
     updateGroup,
     deleteGroupInternal,
+    deleteApp,
     DeleteGroupManagedError (..),
   )
 where
@@ -168,6 +169,7 @@ data BrigAPIAccess m a where
   GetGroupsInternal :: TeamId -> Maybe Scim.Filter -> Maybe ManagedBy -> Word -> Maybe Word -> BrigAPIAccess m UserGroupPageWithMembers
   UpdateGroup :: UpdateGroupInternalRequest -> BrigAPIAccess m (Either Wai.Error ())
   DeleteGroupInternal :: ManagedBy -> TeamId -> UserGroupId -> BrigAPIAccess m (Either DeleteGroupManagedError ())
+  DeleteApp :: TeamId -> UserId -> BrigAPIAccess m ()
 
 makeSem ''BrigAPIAccess
 

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

@@ -136,6 +136,8 @@ interpretBrigAccess brigEndpoint =
         updateGroup req
       DeleteGroupInternal managedBy teamId groupId ->
         deleteGroupInternal managedBy teamId groupId
+      DeleteApp teamId userId ->
+        deleteApp teamId userId
 
 brigRequest :: (Member Rpc r, Member (Input Endpoint) r) => (Request -> Request) -> Sem r (Response (Maybe LByteString))
 brigRequest req = do
@@ -699,6 +701,18 @@ deleteGroupInternal managedBy teamId groupId = do
     errorLabel :: ResponseLBS -> Maybe LText
     errorLabel = fmap Wai.label . responseJsonMaybe
 
+deleteApp ::
+  (Member Rpc r, Member (Input Endpoint) r) =>
+  TeamId ->
+  UserId ->
+  Sem r ()
+deleteApp teamId userId = do
+  void $
+    brigRequest $
+      method DELETE
+        . paths ["i", "teams", toByteString' teamId, "apps", toByteString' userId]
+        . expect2xx
+
 is2xx :: ResponseLBS -> Bool
 is2xx = statusIs2xx . statusCode
 

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

@@ -32,3 +32,4 @@ inMemoryAppStoreInterpreter = interpret $ \case
   CreateApp app -> modify (app :)
   GetApp uid tid -> gets $ find $ \app -> app.id == uid && app.teamId == tid
   GetApps tid -> gets $ filter $ \app -> app.teamId == tid
+  DeleteApp uid tid -> modify $ filter $ \app -> not (app.id == uid && app.teamId == tid)

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

@@ -96,6 +96,8 @@ import Wire.API.UserEvent
 import Wire.API.UserGroup (UserGroup)
 import Wire.API.UserGroup.Pagination
 import Wire.ActivationCodeStore (ActivationCodeStore)
+import Wire.AppSubsystem (AppSubsystem)
+import Wire.AppSubsystem qualified as AppSubsystem
 import Wire.AuthenticationSubsystem (AuthenticationSubsystem)
 import Wire.AuthenticationSubsystem.Config (AuthenticationSubsystemConfig)
 import Wire.BlockListStore (BlockListStore)
@@ -182,7 +184,8 @@ servantSitemap ::
     Member Now r,
     Member CryptoSign r,
     Member Random r,
-    Member SAMLEmailSubsystem r
+    Member SAMLEmailSubsystem r,
+    Member AppSubsystem r
   ) =>
   ServerT BrigIRoutes.API (Handler r)
 servantSitemap =
@@ -201,6 +204,7 @@ servantSitemap =
     :<|> Provider.internalProviderAPI
     :<|> enterpriseLoginApi
     :<|> samlIdPApi
+    :<|> Named @"i-delete-app" deleteAppH
 
 istatusAPI :: forall r. ServerT BrigIRoutes.IStatusAPI (Handler r)
 istatusAPI = Named @"get-status" (pure NoContent)
@@ -1058,3 +1062,6 @@ deleteGroupManagedInternalH ::
 deleteGroupManagedInternalH tid gid managedBy = do
   lift . liftSem $ deleteGroupManaged managedBy tid gid
   pure NoContent
+
+deleteAppH :: (Member AppSubsystem r) => TeamId -> UserId -> Handler r NoContent
+deleteAppH tid uid = lift . liftSem $ AppSubsystem.deleteApp tid uid >> pure NoContent

services/galley/src/Galley/API/Teams.hs

@@ -806,6 +806,7 @@ deleteTeamMember' lusr zcon tid remove mBody = do
               then 0
               else sizeBeforeDelete - 1
       E.deleteUser remove
+      E.deleteApp tid remove
       owners <- E.getBillingTeamMembers tid
       Journal.teamUpdate tid sizeAfterDelete $ filter (/= remove) owners
       pure TeamMemberDeleteAccepted