Make deletions via SCIM more stable

changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim

@@ -0,0 +1 @@
+SCIM user deletion suffered from a couple of race conditions. The user in now first deleted in spar, because this process depends on data from brig. Then, the user is deleted in brig. If any error occurs, the SCIM deletion request can be made again. This change depends on brig being completely deployed before using the SCIM deletion endpoint in brig. In the unlikely event of using SCIM deletion during the deployment, these requests can be retried (in case of error).

libs/wire-api/src/Wire/API/Connection.hs

@@ -168,7 +168,7 @@ data Relation
   | Cancelled
   | -- | behaves like blocked, the extra constructor is just to inform why.
     MissingLegalholdConsent
-  deriving stock (Eq, Ord, Show, Generic)
+  deriving stock (Bounded, Enum, Eq, Ord, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Relation)
   deriving (FromJSON, ToJSON, S.ToSchema) via (Schema Relation)
 

libs/wire-api/src/Wire/API/User.hs

@@ -95,6 +95,7 @@ module Wire.API.User
     VerifyDeleteUser (..),
     mkVerifyDeleteUser,
     DeletionCodeTimeout (..),
+    DeleteUserResult (..),
 
     -- * List Users
     ListUsersQuery (..),
@@ -1356,6 +1357,16 @@ instance FromJSON DeletionCodeTimeout where
   parseJSON = A.withObject "DeletionCodeTimeout" $ \o ->
     DeletionCodeTimeout <$> o A..: "expires_in"
 
+-- | Result of an internal user/account deletion
+data DeleteUserResult
+  = -- | User never existed
+    NoUser
+  | -- | User/account was deleted before
+    AccountAlreadyDeleted
+  | -- | User/account was deleted in this call
+    AccountDeleted
+  deriving (Eq, Show)
+
 data ListUsersQuery
   = ListUsersByIds [Qualified UserId]
   | ListUsersByHandles (Range 1 4 [Qualified Handle])

services/brig/brig.cabal

@@ -204,6 +204,7 @@ library
     , errors                     >=1.4
     , exceptions                 >=0.5
     , extended
+    , extra
     , file-embed
     , file-embed-lzma
     , filepath                   >=1.3

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

@@ -42,12 +42,12 @@ import qualified Brig.Data.MLS.KeyPackage as Data
 import qualified Brig.Data.User as Data
 import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore)
 import Brig.Effects.BlacklistStore (BlacklistStore)
-import qualified Brig.IO.Intra as Intra
-import Brig.Options hiding (internalEvents, sesQueue)
-import qualified Brig.Provider.API as Provider
 import Brig.Effects.CodeStore (CodeStore)
 import Brig.Effects.PasswordResetStore (PasswordResetStore)
 import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
+import qualified Brig.IO.Intra as Intra
+import Brig.Options hiding (internalEvents, sesQueue)
+import qualified Brig.Provider.API as Provider
 import qualified Brig.Team.API as Team
 import Brig.Team.DB (lookupInvitationByEmail)
 import Brig.Types.Connection
@@ -286,7 +286,7 @@ sitemap = do
   -- This endpoint will lead to the following events being sent:
   -- - UserDeleted event to all of its contacts
   -- - MemberLeave event to members for all conversations the user was in (via galley)
-  delete "/i/users/:uid" (continue deleteUserNoVerifyH) $
+  delete "/i/users/:uid" (continue deleteUserNoAuthH) $
     capture "uid"
 
   put "/i/connections/connection-update" (continue updateConnectionInternalH) $
@@ -508,16 +508,13 @@ createUserNoVerifySpar uData =
        in API.activate key code (Just uid) !>> CreateUserSparRegistrationError . activationErrorToRegisterError
     pure . SelfProfile $ usr
 
-deleteUserNoVerifyH :: UserId -> (Handler r) Response
-deleteUserNoVerifyH uid = do
-  setStatus status202 empty <$ deleteUserNoVerify uid
-
-deleteUserNoVerify :: UserId -> (Handler r) ()
-deleteUserNoVerify uid = do
-  void $
-    lift (wrapClient $ API.lookupAccount uid)
-      >>= ifNothing (errorToWai @'E.UserNotFound)
-  lift $ API.deleteUserNoVerify uid
+deleteUserNoAuthH :: UserId -> (Handler r) Response
+deleteUserNoAuthH uid = do
+  r <- lift $ wrapHttp $ API.ensureAccountDeleted uid
+  case r of
+    NoUser -> throwStd (errorToWai @'E.UserNotFound)
+    AccountAlreadyDeleted -> pure $ setStatus ok200 empty
+    AccountDeleted -> pure $ setStatus accepted202 empty
 
 changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response
 changeSelfEmailMaybeSendH (u ::: validate ::: req) = do
@@ -796,8 +793,3 @@ getContactListH :: JSON ::: UserId -> (Handler r) Response
 getContactListH (_ ::: uid) = do
   contacts <- lift . wrapClient $ API.lookupContactList uid
   pure $ json $ UserIds contacts
-
--- Utilities
-
-ifNothing :: Utilities.Error -> Maybe a -> (Handler r) a
-ifNothing e = maybe (throwStd e) pure

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

@@ -46,12 +46,12 @@ import qualified Brig.Data.User as Data
 import qualified Brig.Data.UserKey as UserKey
 import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore)
 import Brig.Effects.BlacklistStore (BlacklistStore)
-import qualified Brig.IO.Intra as Intra
-import Brig.Options hiding (internalEvents, sesQueue)
-import qualified Brig.Provider.API as Provider
 import Brig.Effects.CodeStore (CodeStore)
 import Brig.Effects.PasswordResetStore (PasswordResetStore)
 import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
+import qualified Brig.IO.Intra as Intra
+import Brig.Options hiding (internalEvents, sesQueue)
+import qualified Brig.Provider.API as Provider
 import qualified Brig.Team.API as Team
 import qualified Brig.Team.Email as Team
 import Brig.Types.Activation (ActivationPair)

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

@@ -54,6 +54,7 @@ module Brig.API.User
     deleteUsersNoVerify,
     deleteSelfUser,
     verifyDeleteUser,
+    ensureAccountDeleted,
     deleteAccount,
     checkHandles,
     isBlacklistedHandle,
@@ -100,6 +101,7 @@ import qualified Brig.Code as Code
 import Brig.Data.Activation (ActivationEvent (..), activationErrorToRegisterError)
 import qualified Brig.Data.Activation as Data
 import qualified Brig.Data.Client as Data
+import Brig.Data.Connection (countConnections)
 import qualified Brig.Data.Connection as Data
 import qualified Brig.Data.Properties as Data
 import Brig.Data.User
@@ -110,25 +112,25 @@ import Brig.Effects.BlacklistPhonePrefixStore (BlacklistPhonePrefixStore)
 import qualified Brig.Effects.BlacklistPhonePrefixStore as BlacklistPhonePrefixStore
 import Brig.Effects.BlacklistStore (BlacklistStore)
 import qualified Brig.Effects.BlacklistStore as BlacklistStore
-import qualified Brig.Federation.Client as Federation
-import qualified Brig.IO.Intra as Intra
-import qualified Brig.InternalEvent.Types as Internal
-import Brig.Options hiding (Timeout, internalEvents)
-import Brig.Password
-import qualified Brig.Queue as Queue
 import Brig.Effects.CodeStore (CodeStore)
 import qualified Brig.Effects.CodeStore as E
 import Brig.Effects.PasswordResetStore (PasswordResetStore)
 import qualified Brig.Effects.PasswordResetStore as E
 import Brig.Effects.UserPendingActivationStore (UserPendingActivation (..), UserPendingActivationStore)
 import qualified Brig.Effects.UserPendingActivationStore as UserPendingActivationStore
+import qualified Brig.Federation.Client as Federation
+import qualified Brig.IO.Intra as Intra
+import qualified Brig.InternalEvent.Types as Internal
+import Brig.Options hiding (Timeout, internalEvents)
+import Brig.Password
+import qualified Brig.Queue as Queue
 import qualified Brig.Team.DB as Team
 import Brig.Types.Activation (ActivationPair)
 import Brig.Types.Connection
 import Brig.Types.Intra
 import Brig.Types.User (HavePendingInvitations (..), ManagedByUpdate (..), PasswordResetPair)
 import Brig.Types.User.Event
-import Brig.User.Auth.Cookie (revokeAllCookies)
+import Brig.User.Auth.Cookie (listCookies, revokeAllCookies)
 import Brig.User.Email
 import Brig.User.Handle
 import Brig.User.Handle.Blacklist
@@ -147,6 +149,7 @@ import Data.Handle (Handle (fromHandle), parseHandle)
 import Data.Id as Id
 import Data.Json.Util
 import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus)
+import Data.List.Extra
 import Data.List1 as List1 (List1, singleton)
 import qualified Data.Map.Strict as Map
 import qualified Data.Metrics as Metrics
@@ -1230,10 +1233,57 @@ verifyDeleteUser d = do
   for_ account $ lift . wrapHttpClient . deleteAccount
   lift . wrapClient $ Code.delete key Code.AccountDeletion
 
--- | Internal deletion without validation.  Called via @delete /i/user/:uid@, or indirectly
--- via deleting self.
--- Team owners can be deleted if the team is not orphaned, i.e. there is at least one
--- other owner left.
+-- | Check if `deleteAccount` succeeded and run it again if needed.
+-- Called via @delete /i/user/:uid@.
+ensureAccountDeleted ::
+  ( MonadLogger m,
+    MonadCatch m,
+    MonadThrow m,
+    MonadIndexIO m,
+    MonadReader Env m,
+    MonadIO m,
+    MonadMask m,
+    MonadHttp m,
+    HasRequestId m,
+    MonadUnliftIO m,
+    MonadClient m,
+    MonadReader Env m
+  ) =>
+  UserId ->
+  m DeleteUserResult
+ensureAccountDeleted uid = do
+  mbAcc <- lookupAccount uid
+  case mbAcc of
+    Nothing -> pure NoUser
+    Just acc -> do
+      probs <- Data.lookupPropertyKeysAndValues uid
+
+      let accIsDeleted = accountStatus acc == Deleted
+      clients <- Data.lookupClients uid
+
+      localUid <- qualifyLocal uid
+      conCount <- countConnections localUid [(minBound @Relation) .. maxBound]
+      cookies <- listCookies uid []
+
+      if notNull probs
+        || not accIsDeleted
+        || notNull clients
+        || conCount > 0
+        || notNull cookies
+        then do
+          deleteAccount acc
+          pure AccountDeleted
+        else pure AccountAlreadyDeleted
+
+-- | Internal deletion without validation.
+--
+-- Called via @delete /i/user/:uid@ (through `ensureAccountDeleted`), or
+-- indirectly via deleting self. Team owners can be deleted if the team is not
+-- orphaned, i.e. there is at least one other owner left.
+--
+-- N.B.: As Cassandra doesn't support transactions, the order of database
+-- statements matters! Other functions reason upon some states to imply other
+-- states. Please change this order only with care!
 deleteAccount ::
   ( MonadLogger m,
     MonadIndexIO m,
@@ -1250,8 +1300,8 @@ deleteAccount account@(accountUser -> user) = do
   let uid = userId user
   Log.info $ field "user" (toByteString uid) . msg (val "Deleting account")
   -- Free unique keys
-  for_ (userEmail user) $ deleteKey . userEmailKey
-  for_ (userPhone user) $ deleteKey . userPhoneKey
+  for_ (userEmail user) $ deleteKeyForUser uid . userEmailKey
+  for_ (userPhone user) $ deleteKeyForUser uid . userPhoneKey
   for_ (userHandle user) $ freeHandle (userId user)
   -- Wipe data
   Data.clearProperties uid

services/brig/src/Brig/Data/Activation.hs

@@ -34,9 +34,9 @@ where
 import Brig.App (Env)
 import Brig.Data.User
 import Brig.Data.UserKey
-import Brig.Options
 import qualified Brig.Effects.CodeStore as E
 import Brig.Effects.CodeStore.Cassandra
+import Brig.Options
 import Brig.Types.Intra
 import Cassandra
 import Control.Error

services/brig/src/Brig/Data/UserKey.hs

@@ -29,6 +29,7 @@ module Brig.Data.UserKey
     keyAvailable,
     lookupKey,
     deleteKey,
+    deleteKeyForUser,
     lookupPhoneHashes,
   )
 where
@@ -164,6 +165,21 @@ deleteKey k = do
   retry x5 $ write deleteHashed (params LocalQuorum (Identity hk))
   retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k))
 
+-- | Delete `UserKey` for `UserId`
+--
+-- This function ensures that keys of other users aren't accidentally deleted.
+-- E.g. the email address or phone number of a partially deleted user could
+-- already belong to a new user. To not interrupt deletion flows (that may be
+-- executed several times due to cassandra not supporting transactions)
+-- `deleteKeyForUser` does not fail for missing keys or keys that belong to
+-- another user: It always returns `()` as result.
+deleteKeyForUser :: (MonadClient m, MonadReader Env m) => UserId -> UserKey -> m ()
+deleteKeyForUser uid k = do
+  mbKeyUid <- lookupKey k
+  case mbKeyUid of
+    Just keyUid | keyUid == uid -> deleteKey k
+    _ -> pure ()
+
 hashKey :: MonadReader Env m => UserKey -> m UserKeyHash
 hashKey uk = do
   d <- view digestSHA256

services/brig/src/Brig/Run.hs

@@ -36,11 +36,11 @@ import qualified Brig.AWS.SesNotification as SesNotification
 import Brig.App
 import qualified Brig.Calling as Calling
 import Brig.CanonicalInterpreter
+import Brig.Effects.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore)
+import qualified Brig.Effects.UserPendingActivationStore as UsersPendingActivationStore
 import qualified Brig.InternalEvent.Process as Internal
 import Brig.Options hiding (internalEvents, sesQueue)
 import qualified Brig.Queue as Queue
-import Brig.Effects.UserPendingActivationStore (UserPendingActivation (UserPendingActivation), UserPendingActivationStore)
-import qualified Brig.Effects.UserPendingActivationStore as UsersPendingActivationStore
 import Brig.Types.Intra (AccountStatus (PendingInvitation))
 import Brig.Version
 import qualified Control.Concurrent.Async as Async

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

@@ -31,11 +31,11 @@ import Brig.Data.UserKey
 import qualified Brig.Data.UserKey as Data
 import Brig.Effects.BlacklistStore (BlacklistStore)
 import qualified Brig.Effects.BlacklistStore as BlacklistStore
+import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
 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.Effects.UserPendingActivationStore (UserPendingActivationStore)
 import qualified Brig.Team.DB as DB
 import Brig.Team.Email
 import Brig.Team.Util (ensurePermissionToAddUser, ensurePermissions)

services/brig/src/Brig/User/Handle.hs

@@ -59,9 +59,13 @@ claimHandle uid oldHandle newHandle =
 -- | Free a 'Handle', making it available to be claimed again.
 freeHandle :: MonadClient m => UserId -> Handle -> m ()
 freeHandle uid h = do
-  retry x5 $ write handleDelete (params LocalQuorum (Identity h))
-  let key = "@" <> fromHandle h
-  deleteClaim uid key (30 # Minute)
+  mbHandleUid <- lookupHandle h
+  case mbHandleUid of
+    Just handleUid | handleUid == uid -> do
+      retry x5 $ write handleDelete (params LocalQuorum (Identity h))
+      let key = "@" <> fromHandle h
+      deleteClaim uid key (30 # Minute)
+    _ -> pure () -- this shouldn't happen, the call side should always check that `h` and `uid` belong to the same account.
 
 -- | Lookup the current owner of a 'Handle'.
 lookupHandle :: MonadClient m => Handle -> m (Maybe UserId)