From a7e5d70c99a6825b01b31fd6db29d782a82c3780 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 18 Aug 2022 17:32:37 +0200 Subject: [PATCH 01/56] Add remarks --- services/spar/src/Spar/Scim/User.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 637f28ac99..17de3a2d04 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -698,6 +698,9 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = ) (const id) $ do + -- SQPIT-1189: This function only returns non-deleted users; no tombstones + -- A special handling for deleted users might be useful: verifyDeleteUserH (brig) + -- SQPIT-1189: Shouldn't spar rely on it's own data? mbBrigUser <- lift (Brig.getBrigUser Brig.WithPendingInvitations uid) case mbBrigUser of Nothing -> @@ -723,8 +726,8 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = (SAMLUserStore.delete uid) (ScimExternalIdStore.delete stiTeam) veid - lift $ ScimUserTimesStore.delete uid + -- SQPIT-1189: N.B.: this emits a deletion event and then immediately returns lift $ BrigAccess.delete uid pure () From 7df2818cba63e186b205174c7aed268a2773d9dc Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 19 Aug 2022 18:44:06 +0200 Subject: [PATCH 02/56] Sketch out a solution --- libs/wire-api/src/Wire/API/Connection.hs | 2 +- .../src/Wire/API/Routes/Internal/Brig.hs | 7 ++ libs/wire-api/src/Wire/API/User.hs | 14 ++++ services/brig/src/Brig/API/Internal.hs | 4 ++ services/brig/src/Brig/API/User.hs | 49 +++++++++++++- services/spar/src/Spar/Intra/Brig.hs | 38 +++++++++++ services/spar/src/Spar/Intra/BrigApp.hs | 8 +++ services/spar/src/Spar/Scim/User.hs | 65 ++++++++++++------- services/spar/src/Spar/Sem/BrigAccess.hs | 7 +- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 3 + 10 files changed, 172 insertions(+), 25 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Connection.hs b/libs/wire-api/src/Wire/API/Connection.hs index fa3fc2af11..6da96c6345 100644 --- a/libs/wire-api/src/Wire/API/Connection.hs +++ b/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) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 1c03b4f6e9..4a336cc1a5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -156,6 +156,13 @@ type AccountAPI = :> ReqBody '[Servant.JSON] NewUserSpar :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile) ) + :<|> Named + "verify-user-deleted" + ( "users" + :> Capture "uid" UserId + :> "verify-deleted" + :> Post '[Servant.JSON] VerifyDeleteInternalResult + ) -- | The missing ref is implicit by the capture data NewKeyPackageRef = NewKeyPackageRef diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 87f9d1fa3e..c9df8b188a 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -95,6 +95,7 @@ module Wire.API.User VerifyDeleteUser (..), mkVerifyDeleteUser, DeletionCodeTimeout (..), + VerifyDeleteInternalResult (..), -- * List Users ListUsersQuery (..), @@ -1356,6 +1357,19 @@ instance FromJSON DeletionCodeTimeout where parseJSON = A.withObject "DeletionCodeTimeout" $ \o -> DeletionCodeTimeout <$> o A..: "expires_in" +data VerifyDeleteInternalResult = NoUser | FullyDeletedUser | RanDeletionAgain + deriving (Eq) + deriving (S.ToSchema, ToJSON, FromJSON) via (Schema VerifyDeleteInternalResult) + +instance ToSchema VerifyDeleteInternalResult where + schema = + enum @Text "VerifyDeleteInternalResult" $ + mconcat + [ element "no-user" NoUser, + element "fully-deleted-user" FullyDeletedUser, + element "had-to-run-deletion-again" RanDeletionAgain + ] + data ListUsersQuery = ListUsersByIds [Qualified UserId] | ListUsersByHandles (Range 1 4 [Qualified Handle]) diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index d5f62c1472..e466d85d92 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -144,6 +144,7 @@ accountAPI :: accountAPI = Named @"createUserNoVerify" createUserNoVerify :<|> Named @"createUserNoVerifySpar" createUserNoVerifySpar + :<|> Named @"verify-user-deleted" verifyUserDeleted teamsAPI :: ServerT BrigIRoutes.TeamsAPI (Handler r) teamsAPI = Named @"updateSearchVisibilityInbound" Index.updateSearchVisibilityInbound @@ -519,6 +520,9 @@ deleteUserNoVerify uid = do >>= ifNothing (errorToWai @'E.UserNotFound) lift $ API.deleteUserNoVerify uid +verifyUserDeleted :: UserId -> (Handler r) VerifyDeleteInternalResult +verifyUserDeleted uid = lift $ wrapHttp $ API.verifyDeleteUserInternal uid + changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response changeSelfEmailMaybeSendH (u ::: validate ::: req) = do email <- euEmail <$> parseJsonBody req diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 3fd0834bcd..c9470e67b4 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -54,6 +54,7 @@ module Brig.API.User deleteUsersNoVerify, deleteSelfUser, verifyDeleteUser, + verifyDeleteUserInternal, 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 @@ -128,7 +130,7 @@ 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 @@ -1230,6 +1232,51 @@ verifyDeleteUser d = do for_ account $ lift . wrapHttpClient . deleteAccount lift . wrapClient $ Code.delete key Code.AccountDeletion +-- | Check if `deleteAccount` succeeded and run it again if needed +verifyDeleteUserInternal :: + ( 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 VerifyDeleteInternalResult +verifyDeleteUserInternal uid = do + acc <- lookupAccount uid + if isNothing acc + then pure NoUser + else do + -- TODO: `fromJust` is ugly + -- TODO: Is it still valid to check for email, phone and handle - can't they belong to other users?` + let user = accountUser (fromJust acc) + mbEmail <- for (userEmail user) $ lookupKey . userEmailKey + mbPhone <- for (userPhone user) $ lookupKey . userPhoneKey + mbHandle <- for (userHandle user) $ lookupHandle + + probs <- Data.lookupPropertyKeysAndValues uid + + let accIsDeleted = accountStatus (fromJust acc) == Deleted + clients <- Data.lookupClients uid + + localUid <- qualifyLocal uid + conCount <- countConnections localUid [minBound .. maxBound] + cookies <- listCookies uid [] + + if isJust mbEmail || isJust mbPhone || isJust mbHandle || (not . null) probs || not accIsDeleted || (not . null) clients || conCount > 0 || (not . null) cookies + then do + -- TODO: Catch errors? + deleteAccount $ fromJust acc + pure RanDeletionAgain + else pure FullyDeletedUser + -- | 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 diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 5d23d79655..375e2064b9 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -19,6 +19,7 @@ module Spar.Intra.Brig ( MonadSparToBrig (..), getBrigUserAccount, + getBrigUserAccountIncludeAll, getBrigUserByHandle, getBrigUserByEmail, getBrigUserRichInfo, @@ -30,6 +31,7 @@ module Spar.Intra.Brig setBrigUserLocale, checkHandleAvailable, deleteBrigUser, + verifyDeletionBrigUser, createBrigUserSAML, createBrigUserNoSAML, updateEmail, @@ -183,6 +185,30 @@ getBrigUserAccount havePending buid = do 404 -> pure Nothing _ -> rethrow "brig" resp +-- | Get a user; returns 'Nothing' if the user was not found. +-- Includes users with deleted accounts and pending invitations. +getBrigUserAccountIncludeAll :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe UserAccount) +getBrigUserAccountIncludeAll buid = do + resp :: ResponseLBS <- + call $ + method GET + . paths ["/i/users"] + . query + [ ("ids", Just $ toByteString' buid), + ( "includePendingInvitations", + Just $ toByteString' True + ) + ] + + case statusCode resp of + 200 -> + parseResponse @[UserAccount] "brig" resp >>= \case + [account] -> + pure $ Just account + _ -> pure Nothing + 404 -> pure Nothing + _ -> rethrow "brig" resp + -- | Get a user; returns 'Nothing' if the user was not found. -- -- TODO: currently this is not used, but it might be useful later when/if @@ -339,6 +365,18 @@ deleteBrigUser buid = do unless (statusCode resp == 202) $ rethrow "brig" resp +-- | Call brig to verify that a user has been completely deleted. +-- Otherwise, do another deletion. +verifyDeletionBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m VerifyDeleteInternalResult +verifyDeletionBrigUser buid = do + resp <- + call $ + method POST + . paths ["/i/users", toByteString' buid, "verify-deleted"] + case statusCode resp of + 200 -> parseResponse "brig" resp + _ -> rethrow "brig" resp + -- | Verify user's password (needed for certain powerful operations). ensureReAuthorised :: (HasCallStack, MonadSparToBrig m) => diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index 6043970a05..da9db42c2c 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -28,11 +28,13 @@ module Spar.Intra.BrigApp renderValidExternalId, HavePendingInvitations (..), getBrigUser, + getBrigUserIncludeAll, getBrigUserTeam, getZUsrCheckPerm, authorizeScimTokenManagement, parseResponse, giveDefaultHandle, + verifyBrigUserDeletion, -- * re-exports, mostly for historical reasons and lazyness emailFromSAML, @@ -115,6 +117,9 @@ renderValidExternalId = runValidExternalIdEither urefToExternalId (Just . fromEm getBrigUser :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe User) getBrigUser ifpend = (accountUser <$$>) . BrigAccess.getAccount ifpend +getBrigUserIncludeAll :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r (Maybe User) +getBrigUserIncludeAll = (accountUser <$$>) . BrigAccess.getAccountIncludeAll + -- | Check that an id maps to an user on brig that is 'Active' (or optionally -- 'PendingInvitation') and has a team id. getBrigUserTeam :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe TeamId) @@ -169,3 +174,6 @@ giveDefaultHandle usr = case userHandle usr of uid = userId usr BrigAccess.setHandle uid handle pure handle + +verifyBrigUserDeletion :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r VerifyDeleteInternalResult +verifyBrigUserDeletion = BrigAccess.verifyUserDeleted diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 17de3a2d04..4727200179 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -698,14 +698,9 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = ) (const id) $ do - -- SQPIT-1189: This function only returns non-deleted users; no tombstones - -- A special handling for deleted users might be useful: verifyDeleteUserH (brig) - -- SQPIT-1189: Shouldn't spar rely on it's own data? - mbBrigUser <- lift (Brig.getBrigUser Brig.WithPendingInvitations uid) + mbBrigUser <- lift $ Brig.getBrigUserIncludeAll uid case mbBrigUser of - Nothing -> - -- double-deletion gets you a 404. - throwError $ Scim.notFound "user" (idToText uid) + Nothing -> throwError $ Scim.notFound "user" (idToText uid) Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM -- (because that owner won't be managed by SCIM in the first place), but if it ever becomes @@ -715,21 +710,47 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = throwError $ Scim.notFound "user" (idToText uid) - mIdpConfig <- mapM (lift . IdPConfigStore.getConfig) stiIdP - - case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of - Left _ -> pure () - Right veid -> - lift $ - ST.runValidExternalIdBoth - (>>) - (SAMLUserStore.delete uid) - (ScimExternalIdStore.delete stiTeam) - veid - lift $ ScimUserTimesStore.delete uid - -- SQPIT-1189: N.B.: this emits a deletion event and then immediately returns - lift $ BrigAccess.delete uid - pure () + if userDeleted brigUser + then do + deletionStatus <- lift $ Brig.verifyBrigUserDeletion uid + case deletionStatus of + NoUser -> + throwError $ + Scim.notFound "user" (idToText uid) + FullyDeletedUser -> + throwError $ + Scim.notFound "user" (idToText uid) + RanDeletionAgain -> + deleteUserInSpar brigUser + else do + deleteUserInSpar brigUser + -- SQPIT-1189: N.B.: this emits a deletion event and then immediately returns + lift $ BrigAccess.delete uid + pure () + where + deleteUserInSpar :: + Members + '[ IdPConfigStore, + SAMLUserStore, + ScimExternalIdStore, + ScimUserTimesStore + ] + r => + User -> + Scim.ScimHandler (Sem r) () + deleteUserInSpar brigUser = do + mIdpConfig <- mapM (lift . IdPConfigStore.getConfig) stiIdP + + case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of + Left _ -> pure () + Right veid -> + lift $ + ST.runValidExternalIdBoth + (>>) + (SAMLUserStore.delete uid) + (ScimExternalIdStore.delete stiTeam) + veid + lift $ ScimUserTimesStore.delete uid ---------------------------------------------------------------------------- -- Utilities diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index b756f4f262..78b501ff77 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -23,6 +23,7 @@ module Spar.Sem.BrigAccess createNoSAML, updateEmail, getAccount, + getAccountIncludeAll, getByHandle, getByEmail, setName, @@ -34,6 +35,7 @@ module Spar.Sem.BrigAccess getRichInfo, checkHandleAvailable, delete, + verifyUserDeleted, ensureReAuthorised, ssoLogin, getStatus, @@ -53,7 +55,7 @@ import Imports import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie -import Wire.API.User (VerificationAction) +import Wire.API.User (VerificationAction, VerifyDeleteInternalResult) import Wire.API.User.Identity import Wire.API.User.Profile import Wire.API.User.RichInfo as RichInfo @@ -64,6 +66,8 @@ data BrigAccess m a where CreateNoSAML :: Email -> TeamId -> Name -> Maybe Locale -> BrigAccess m UserId UpdateEmail :: UserId -> Email -> BrigAccess m () GetAccount :: HavePendingInvitations -> UserId -> BrigAccess m (Maybe UserAccount) + -- | Includes deleted accounts and those with pending invitation + GetAccountIncludeAll :: UserId -> BrigAccess m (Maybe UserAccount) GetByHandle :: Handle -> BrigAccess m (Maybe UserAccount) GetByEmail :: Email -> BrigAccess m (Maybe UserAccount) SetName :: UserId -> Name -> BrigAccess m () @@ -75,6 +79,7 @@ data BrigAccess m a where GetRichInfo :: UserId -> BrigAccess m RichInfo CheckHandleAvailable :: Handle -> BrigAccess m Bool Delete :: UserId -> BrigAccess m () + VerifyUserDeleted :: UserId -> BrigAccess m VerifyDeleteInternalResult EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () SsoLogin :: UserId -> BrigAccess m SetCookie GetStatus :: UserId -> BrigAccess m AccountStatus diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 122bdc3496..354b3b1c0f 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -26,6 +26,7 @@ import Polysemy import Polysemy.Error (Error) import Spar.Error (SparError) import qualified Spar.Intra.Brig as Intra +import qualified Spar.Intra.Brig as Itra import Spar.Sem.BrigAccess import Spar.Sem.Utils (RunHttpEnv (..), viaRunHttp) import qualified System.Logger as TinyLog @@ -44,6 +45,7 @@ brigAccessToHttp mgr req = CreateNoSAML e itlt n ml -> Intra.createBrigUserNoSAML e itlt n ml UpdateEmail itlu e -> Intra.updateEmail itlu e GetAccount h itlu -> Intra.getBrigUserAccount h itlu + GetAccountIncludeAll h -> Intra.getBrigUserAccountIncludeAll h GetByHandle h -> Intra.getBrigUserByHandle h GetByEmail e -> Intra.getBrigUserByEmail e SetName itlu n -> Intra.setBrigUserName itlu n @@ -55,6 +57,7 @@ brigAccessToHttp mgr req = GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu CheckHandleAvailable h -> Intra.checkHandleAvailable h Delete itlu -> Intra.deleteBrigUser itlu + VerifyUserDeleted itlu -> Itra.verifyDeletionBrigUser itlu EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma SsoLogin itlu -> Intra.ssoLogin itlu GetStatus itlu -> Intra.getStatus itlu From e7cc774cea826d526131fa829ddf8c9bb71a9b33 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 22 Aug 2022 11:06:27 +0200 Subject: [PATCH 03/56] Ensure email, phone and handle are only deleted for this specific user Otherwise, there could be some strange corner cases where these are already assigned to another user (or, other users). --- services/brig/src/Brig/API/User.hs | 17 +++++++++++------ services/brig/src/Brig/Data/UserKey.hs | 8 ++++++++ services/brig/src/Brig/User/Handle.hs | 10 +++++++--- 3 files changed, 26 insertions(+), 9 deletions(-) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index c9470e67b4..b44a49a2f2 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1257,9 +1257,9 @@ verifyDeleteUserInternal uid = do -- TODO: `fromJust` is ugly -- TODO: Is it still valid to check for email, phone and handle - can't they belong to other users?` let user = accountUser (fromJust acc) - mbEmail <- for (userEmail user) $ lookupKey . userEmailKey - mbPhone <- for (userPhone user) $ lookupKey . userPhoneKey - mbHandle <- for (userHandle user) $ lookupHandle + mbEmailUid <- fmap join $ for (userEmail user) $ lookupKey . userEmailKey + mbPhoneUid <- fmap join $ for (userPhone user) $ lookupKey . userPhoneKey + mbHandleUid <- fmap join $ for (userHandle user) $ lookupHandle probs <- Data.lookupPropertyKeysAndValues uid @@ -1270,12 +1270,17 @@ verifyDeleteUserInternal uid = do conCount <- countConnections localUid [minBound .. maxBound] cookies <- listCookies uid [] - if isJust mbEmail || isJust mbPhone || isJust mbHandle || (not . null) probs || not accIsDeleted || (not . null) clients || conCount > 0 || (not . null) cookies + if needsDeletion mbEmailUid || needsDeletion mbPhoneUid || needsDeletion mbHandleUid || (not . null) probs || not accIsDeleted || (not . null) clients || conCount > 0 || (not . null) cookies then do -- TODO: Catch errors? deleteAccount $ fromJust acc pure RanDeletionAgain else pure FullyDeletedUser + where + needsDeletion :: Maybe UserId -> Bool + needsDeletion foundUid = case foundUid of + Just uid' -> uid' == uid + Nothing -> False -- | Internal deletion without validation. Called via @delete /i/user/:uid@, or indirectly -- via deleting self. @@ -1297,8 +1302,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 diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs index 1fbd4cb87c..980b0b68bf 100644 --- a/services/brig/src/Brig/Data/UserKey.hs +++ b/services/brig/src/Brig/Data/UserKey.hs @@ -29,6 +29,7 @@ module Brig.Data.UserKey keyAvailable, lookupKey, deleteKey, + deleteKeyForUser, lookupPhoneHashes, ) where @@ -164,6 +165,13 @@ deleteKey k = do retry x5 $ write deleteHashed (params LocalQuorum (Identity hk)) retry x5 $ write keyDelete (params LocalQuorum (Identity $ keyText k)) +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 diff --git a/services/brig/src/Brig/User/Handle.hs b/services/brig/src/Brig/User/Handle.hs index 710f61affc..c91c8d4a95 100644 --- a/services/brig/src/Brig/User/Handle.hs +++ b/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 () -- | Lookup the current owner of a 'Handle'. lookupHandle :: MonadClient m => Handle -> m (Maybe UserId) From be5fb44dd5af0e7b44e6c13fe1f6b5cb235c2c4e Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 22 Aug 2022 11:45:28 +0200 Subject: [PATCH 04/56] Cleanup verifyDeleteUserInternal --- services/brig/src/Brig/API/User.hs | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index b44a49a2f2..0d3f8fb9ac 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1250,30 +1250,35 @@ verifyDeleteUserInternal :: UserId -> m VerifyDeleteInternalResult verifyDeleteUserInternal uid = do - acc <- lookupAccount uid - if isNothing acc - then pure NoUser - else do - -- TODO: `fromJust` is ugly - -- TODO: Is it still valid to check for email, phone and handle - can't they belong to other users?` - let user = accountUser (fromJust acc) + mbAcc <- lookupAccount uid + case mbAcc of + Nothing -> pure NoUser + Just acc -> do + let user = accountUser acc mbEmailUid <- fmap join $ for (userEmail user) $ lookupKey . userEmailKey mbPhoneUid <- fmap join $ for (userPhone user) $ lookupKey . userPhoneKey mbHandleUid <- fmap join $ for (userHandle user) $ lookupHandle probs <- Data.lookupPropertyKeysAndValues uid - let accIsDeleted = accountStatus (fromJust acc) == Deleted + let accIsDeleted = accountStatus acc == Deleted clients <- Data.lookupClients uid localUid <- qualifyLocal uid conCount <- countConnections localUid [minBound .. maxBound] cookies <- listCookies uid [] - if needsDeletion mbEmailUid || needsDeletion mbPhoneUid || needsDeletion mbHandleUid || (not . null) probs || not accIsDeleted || (not . null) clients || conCount > 0 || (not . null) cookies + if needsDeletion mbEmailUid + || needsDeletion mbPhoneUid + || needsDeletion mbHandleUid + || (not . null) probs + || not accIsDeleted + || (not . null) clients + || conCount > 0 + || (not . null) cookies then do -- TODO: Catch errors? - deleteAccount $ fromJust acc + deleteAccount acc pure RanDeletionAgain else pure FullyDeletedUser where From 56b9b7a35f56224d111d9521076038db9e3126e5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 22 Aug 2022 16:11:59 +0200 Subject: [PATCH 05/56] Rename result type and add first test --- .../src/Wire/API/Routes/Internal/Brig.hs | 2 +- libs/wire-api/src/Wire/API/User.hs | 35 +++++++++++++++---- services/brig/src/Brig/API/Internal.hs | 2 +- services/brig/src/Brig/API/User.hs | 2 +- .../brig/test/integration/API/User/Account.hs | 22 +++++++++++- services/spar/src/Spar/Intra/Brig.hs | 2 +- services/spar/src/Spar/Intra/BrigApp.hs | 2 +- services/spar/src/Spar/Sem/BrigAccess.hs | 4 +-- 8 files changed, 57 insertions(+), 14 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 4a336cc1a5..47e1a42ca5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -161,7 +161,7 @@ type AccountAPI = ( "users" :> Capture "uid" UserId :> "verify-deleted" - :> Post '[Servant.JSON] VerifyDeleteInternalResult + :> Post '[Servant.JSON] VerifyAccountDeletedResult ) -- | The missing ref is implicit by the capture diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index c9df8b188a..c249a3cd76 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -95,7 +95,7 @@ module Wire.API.User VerifyDeleteUser (..), mkVerifyDeleteUser, DeletionCodeTimeout (..), - VerifyDeleteInternalResult (..), + VerifyAccountDeletedResult (..), -- * List Users ListUsersQuery (..), @@ -121,6 +121,7 @@ import Control.Applicative import Control.Error.Safe (rightMay) import Control.Lens (over, view, (.~), (?~), (^.)) import Data.Aeson (FromJSON (..), ToJSON (..)) +import Data.Aeson.Types (parseFail) import qualified Data.Aeson.Types as A import qualified Data.Attoparsec.ByteString as Parser import Data.ByteString.Builder (toLazyByteString) @@ -1357,19 +1358,41 @@ instance FromJSON DeletionCodeTimeout where parseJSON = A.withObject "DeletionCodeTimeout" $ \o -> DeletionCodeTimeout <$> o A..: "expires_in" -data VerifyDeleteInternalResult = NoUser | FullyDeletedUser | RanDeletionAgain - deriving (Eq) - deriving (S.ToSchema, ToJSON, FromJSON) via (Schema VerifyDeleteInternalResult) +data VerifyAccountDeletedResult = NoUser | FullyDeletedUser | RanDeletionAgain + deriving (Eq, Show) + deriving (S.ToSchema) via (Schema VerifyAccountDeletedResult) -instance ToSchema VerifyDeleteInternalResult where +instance ToSchema VerifyAccountDeletedResult where schema = - enum @Text "VerifyDeleteInternalResult" $ + enum @Text "VerifyAccountDeletedResult" $ mconcat [ element "no-user" NoUser, element "fully-deleted-user" FullyDeletedUser, element "had-to-run-deletion-again" RanDeletionAgain ] +instance ToJSON VerifyAccountDeletedResult where + toJSON t = A.object ["tag" A..= toTag t] + where + toTag :: VerifyAccountDeletedResult -> A.Value + toTag NoUser = "no-user" + toTag FullyDeletedUser = "fully-deleted-user" + toTag RanDeletionAgain = "had-to-run-deletion-again" + +instance FromJSON VerifyAccountDeletedResult where + parseJSON (A.Object o) = do + tagString <- o A..: "tag" + case fromTag tagString of + Just t -> pure t + Nothing -> A.parseFail $ "Unknown tag: " ++ tagString + where + fromTag :: String -> Maybe VerifyAccountDeletedResult + fromTag "no-user" = Just NoUser + fromTag "fully-deleted-user" = Just FullyDeletedUser + fromTag "had-to-run-deletion-again" = Just RanDeletionAgain + fromTag _ = Nothing + parseJSON _ = parseFail "Invalid VerifyAccountDeletedResult" + data ListUsersQuery = ListUsersByIds [Qualified UserId] | ListUsersByHandles (Range 1 4 [Qualified Handle]) diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index e466d85d92..25aa7bc24b 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -520,7 +520,7 @@ deleteUserNoVerify uid = do >>= ifNothing (errorToWai @'E.UserNotFound) lift $ API.deleteUserNoVerify uid -verifyUserDeleted :: UserId -> (Handler r) VerifyDeleteInternalResult +verifyUserDeleted :: UserId -> (Handler r) VerifyAccountDeletedResult verifyUserDeleted uid = lift $ wrapHttp $ API.verifyDeleteUserInternal uid changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 0d3f8fb9ac..ee9e50236d 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1248,7 +1248,7 @@ verifyDeleteUserInternal :: MonadReader Env m ) => UserId -> - m VerifyDeleteInternalResult + m VerifyAccountDeletedResult verifyDeleteUserInternal uid = do mbAcc <- lookupAccount uid case mbAcc of diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index e00b11c54f..f270e9ace2 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -160,6 +160,10 @@ tests _ at opts p b c ch g aws = testGroup "update user email by team owner" [ test' aws p "put /users/:uid/email" $ testUpdateUserEmailByTeamOwner b + ], + testGroup + "/i/users/:uid/verify-deleted" + [ test' aws p "does nothing for completely deleted user" $ testVerifyAccountDeletedWithCompletelyDeletedUser b c aws ] ] @@ -1591,7 +1595,7 @@ testRestrictedUserCreation opts brig = do ] postUserRegister' ssoUser brig !!! const 400 === statusCode --- | FUTUREWORK: @setRestrictUserCreation@ perhaps needs to be tested in one place only, since it's the +-- FUTUREWORK: @setRestrictUserCreation@ perhaps needs to be tested in one place only, since it's the -- first thing that we check on the /register endpoint. Other tests that make use of @setRestrictUserCreation@ -- can probably be removed and simplified. It's probably a good candidate for Quickcheck. testTooManyMembersForLegalhold :: Opt.Opts -> Brig -> Http () @@ -1632,6 +1636,22 @@ testTooManyMembersForLegalhold opts brig = do const 403 === statusCode const (Right "too-many-members-for-legalhold") === fmap Wai.label . responseJsonEither +testVerifyAccountDeletedWithCompletelyDeletedUser :: Brig -> Cannon -> AWS.Env -> Http () +testVerifyAccountDeletedWithCompletelyDeletedUser brig cannon aws = do + u <- randomUser brig + liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) + setHandleAndDeleteUser brig cannon u [] aws $ + \uid -> delete (brig . paths ["/i/users", toByteString' uid]) !!! const 202 === statusCode + do + let uid = userId u + post + ( brig + . paths ["/i/users", toByteString' uid, "verify-deleted"] + ) + !!! do + const 200 === statusCode + const (Right FullyDeletedUser) === responseJsonEither + -- helpers setHandleAndDeleteUser :: Brig -> Cannon -> User -> [UserId] -> AWS.Env -> (UserId -> HttpT IO ()) -> Http () diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 375e2064b9..b32cda0c4c 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -367,7 +367,7 @@ deleteBrigUser buid = do -- | Call brig to verify that a user has been completely deleted. -- Otherwise, do another deletion. -verifyDeletionBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m VerifyDeleteInternalResult +verifyDeletionBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m VerifyAccountDeletedResult verifyDeletionBrigUser buid = do resp <- call $ diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index da9db42c2c..e1099719a1 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -175,5 +175,5 @@ giveDefaultHandle usr = case userHandle usr of BrigAccess.setHandle uid handle pure handle -verifyBrigUserDeletion :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r VerifyDeleteInternalResult +verifyBrigUserDeletion :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r VerifyAccountDeletedResult verifyBrigUserDeletion = BrigAccess.verifyUserDeleted diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 78b501ff77..3d6005e748 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -55,7 +55,7 @@ import Imports import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie -import Wire.API.User (VerificationAction, VerifyDeleteInternalResult) +import Wire.API.User (VerificationAction, VerifyAccountDeletedResult) import Wire.API.User.Identity import Wire.API.User.Profile import Wire.API.User.RichInfo as RichInfo @@ -79,7 +79,7 @@ data BrigAccess m a where GetRichInfo :: UserId -> BrigAccess m RichInfo CheckHandleAvailable :: Handle -> BrigAccess m Bool Delete :: UserId -> BrigAccess m () - VerifyUserDeleted :: UserId -> BrigAccess m VerifyDeleteInternalResult + VerifyUserDeleted :: UserId -> BrigAccess m VerifyAccountDeletedResult EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () SsoLogin :: UserId -> BrigAccess m SetCookie GetStatus :: UserId -> BrigAccess m AccountStatus From 2624021b721dd22e5910246c8f6fe13155a15f64 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 22 Aug 2022 16:23:36 +0200 Subject: [PATCH 06/56] Add test for `NoUser` case --- .../brig/test/integration/API/User/Account.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index f270e9ace2..131ba0e51b 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -163,7 +163,8 @@ tests _ at opts p b c ch g aws = ], testGroup "/i/users/:uid/verify-deleted" - [ test' aws p "does nothing for completely deleted user" $ testVerifyAccountDeletedWithCompletelyDeletedUser b c aws + [ test' aws p "does nothing for completely deleted user" $ testVerifyAccountDeletedWithCompletelyDeletedUser b c aws, + test' aws p "does nothing when the uses doesn't exist" $ testVerifyAccountDeletedWithNoUser b ] ] @@ -1652,6 +1653,19 @@ testVerifyAccountDeletedWithCompletelyDeletedUser brig cannon aws = do const 200 === statusCode const (Right FullyDeletedUser) === responseJsonEither +testVerifyAccountDeletedWithNoUser :: Brig -> Http () +testVerifyAccountDeletedWithNoUser brig = + case parseIdFromText "19166173-49eb-49bc-962f-72c95f27a428" of + Right nonExistingUid -> + post + ( brig + . paths ["/i/users", toByteString' nonExistingUid, "verify-deleted"] + ) + !!! do + const 200 === statusCode + const (Right NoUser) === responseJsonEither + Left _ -> fail "Invalid test data! (This should never happen.)" + -- helpers setHandleAndDeleteUser :: Brig -> Cannon -> User -> [UserId] -> AWS.Env -> (UserId -> HttpT IO ()) -> Http () From 6522e64f9345dfe00f5ea786d05c884949de0a7e Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 23 Aug 2022 19:09:16 +0200 Subject: [PATCH 07/56] Add tests. Check only those fields that can be queried. Some relationships are lost due to writing the tombstone. Recreating them would be expensive. --- services/brig/src/Brig/API/User.hs | 28 +++----- .../brig/test/integration/API/User/Account.hs | 68 +++++++++++++++++-- .../brig/test/integration/API/User/Util.hs | 8 +++ 3 files changed, 82 insertions(+), 22 deletions(-) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index ee9e50236d..b746d6ca35 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1254,11 +1254,6 @@ verifyDeleteUserInternal uid = do case mbAcc of Nothing -> pure NoUser Just acc -> do - let user = accountUser acc - mbEmailUid <- fmap join $ for (userEmail user) $ lookupKey . userEmailKey - mbPhoneUid <- fmap join $ for (userPhone user) $ lookupKey . userPhoneKey - mbHandleUid <- fmap join $ for (userHandle user) $ lookupHandle - probs <- Data.lookupPropertyKeysAndValues uid let accIsDeleted = accountStatus acc == Deleted @@ -1268,10 +1263,7 @@ verifyDeleteUserInternal uid = do conCount <- countConnections localUid [minBound .. maxBound] cookies <- listCookies uid [] - if needsDeletion mbEmailUid - || needsDeletion mbPhoneUid - || needsDeletion mbHandleUid - || (not . null) probs + if (not . null) probs || not accIsDeleted || (not . null) clients || conCount > 0 @@ -1281,16 +1273,16 @@ verifyDeleteUserInternal uid = do deleteAccount acc pure RanDeletionAgain else pure FullyDeletedUser - where - needsDeletion :: Maybe UserId -> Bool - needsDeletion foundUid = case foundUid of - Just uid' -> uid' == uid - Nothing -> False - --- | 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 + +-- | 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. +-- +-- 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, diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 131ba0e51b..f519e1b10e 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -46,6 +46,7 @@ import qualified Data.ByteString as C8 import Data.ByteString.Char8 (pack) import Data.ByteString.Conversion import Data.Domain +import Data.Handle import Data.Id hiding (client) import Data.Json.Util (fromUTCTimeMillis) import Data.List1 (singleton) @@ -164,7 +165,9 @@ tests _ at opts p b c ch g aws = testGroup "/i/users/:uid/verify-deleted" [ test' aws p "does nothing for completely deleted user" $ testVerifyAccountDeletedWithCompletelyDeletedUser b c aws, - test' aws p "does nothing when the uses doesn't exist" $ testVerifyAccountDeletedWithNoUser b + test' aws p "does nothing when the uses doesn't exist" $ testVerifyAccountDeletedWithNoUser b, + test' aws p "deletes a not deleted user" $ testVerifyAccountDeletedWithNotDeletedUser b c aws, + test' aws p "delete again because of dangling property" $ testVerifyAccountDeletedWithDanglingProperty b c aws ] ] @@ -1666,18 +1669,75 @@ testVerifyAccountDeletedWithNoUser brig = const (Right NoUser) === responseJsonEither Left _ -> fail "Invalid test data! (This should never happen.)" +testVerifyAccountDeletedWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () +testVerifyAccountDeletedWithNotDeletedUser brig cannon aws = do + u <- randomUser brig + liftIO $ Util.assertUserJournalQueue "user activate" aws (userActivateJournaled u) + do + setHandleAndDeleteUser brig cannon u [] aws $ + ( \uid' -> + verifyAccountDeleted brig uid' !!! do + const 200 === statusCode + const (Right RanDeletionAgain) === responseJsonEither + ) + +testVerifyAccountDeletedWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () +testVerifyAccountDeletedWithDanglingProperty brig cannon aws = do + u <- randomUser brig + liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) + + let uid = userId u + -- First set a unique handle (to verify freeing of the handle) + hdl <- randomHandle + let update = RequestBodyLBS . encode $ HandleUpdate hdl + put (brig . path "/self/handle" . contentJson . zUser uid . zConn "c" . body update) + !!! const 200 === statusCode + + deleteUserInternal uid brig !!! const 202 === statusCode + + setProperty brig (userId u) "foo" objectProp + !!! const 200 === statusCode + getProperty brig (userId u) "foo" !!! do + const 200 === statusCode + const (Just objectProp) === responseJsonMaybe + + execAndAssertUserDeletion brig cannon u (Handle hdl) [] aws $ \uid' -> do + post + ( brig + . paths ["/i/users", toByteString' uid', "verify-deleted"] + ) + !!! do + const 200 === statusCode + const (Right RanDeletionAgain) === responseJsonEither + + getProperty brig (userId u) "foo" !!! do + const 404 === statusCode + where + objectProp = + object + [ "key.1" .= ("val1" :: Text), + "key.2" .= ("val2" :: Text) + ] + -- helpers setHandleAndDeleteUser :: Brig -> Cannon -> User -> [UserId] -> AWS.Env -> (UserId -> HttpT IO ()) -> Http () setHandleAndDeleteUser brig cannon u others aws execDelete = do let uid = userId u - quid = userQualifiedId u - email = fromMaybe (error "Must have an email set") (userEmail u) -- First set a unique handle (to verify freeing of the handle) hdl <- randomHandle let update = RequestBodyLBS . encode $ HandleUpdate hdl put (brig . path "/self/handle" . contentJson . zUser uid . zConn "c" . body update) !!! const 200 === statusCode + + execAndAssertUserDeletion brig cannon u (Handle hdl) others aws execDelete + +execAndAssertUserDeletion :: Brig -> Cannon -> User -> Handle -> [UserId] -> AWS.Env -> (UserId -> HttpT IO ()) -> Http () +execAndAssertUserDeletion brig cannon u hdl others aws execDelete = do + let uid = userId u + quid = userQualifiedId u + email = fromMaybe (error "Must have an email set") (userEmail u) + -- Delete the user WS.bracketRN cannon (uid : others) $ \wss -> do execDelete uid @@ -1701,7 +1761,7 @@ setHandleAndDeleteUser brig cannon u others aws execDelete = do forM_ others $ \usr -> do get (brig . paths ["users", toByteString' uid] . zUser usr) !!! assertDeletedProfilePublic Search.assertCan'tFind brig usr quid (fromName (userDisplayName u)) - Search.assertCan'tFind brig usr quid hdl + Search.assertCan'tFind brig usr quid (fromHandle hdl) -- Email address is available again let Object o = object diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index a2573fc269..9acf2126a8 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -575,3 +575,11 @@ nonce m brig uid cid = . paths ["clients", toByteString' cid, "nonce"] . zUser uid ) + +verifyAccountDeleted :: (MonadIO m, MonadHttp m) => Brig -> UserId -> m ResponseLBS +verifyAccountDeleted brig uid = + post + ( brig + . paths ["/i/users", toByteString' uid, "verify-deleted"] + . expect2xx + ) From 103450bc3bf4c80bf6cb6939b9b60898707a7cc1 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 26 Aug 2022 16:50:35 +0200 Subject: [PATCH 08/56] Fix haddock --- services/spar/test-integration/Util/Scim.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index 93a2eaa33b..08f72bb750 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -409,7 +409,7 @@ patchUser_ auth muid patchop spar_ = . acceptScim ) --- | Update a user. +-- | Delete a user. deleteUser_ :: -- | Authentication Maybe ScimToken -> From c32598e391a3631efd0737525caedaee30000054 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 26 Aug 2022 16:50:59 +0200 Subject: [PATCH 09/56] Ensure that users are first deleted in spar and completely in brig One cannot delete a user in spar that was deleted in brig before. Thus, we're deleting them in spar first and then ensure they're really deleted in spar. --- services/spar/src/Spar/Scim/User.hs | 35 +++++++++++++++-------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 4727200179..34a8b3339a 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -700,7 +700,10 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = $ do mbBrigUser <- lift $ Brig.getBrigUserIncludeAll uid case mbBrigUser of - Nothing -> throwError $ Scim.notFound "user" (idToText uid) + Nothing -> do + -- Ensure there's no left-over of this user in brig. + _ <- lift $ Brig.verifyBrigUserDeletion uid + throwError $ Scim.notFound "user" (idToText uid) Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM -- (because that owner won't be managed by SCIM in the first place), but if it ever becomes @@ -710,22 +713,20 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = throwError $ Scim.notFound "user" (idToText uid) - if userDeleted brigUser - then do - deletionStatus <- lift $ Brig.verifyBrigUserDeletion uid - case deletionStatus of - NoUser -> - throwError $ - Scim.notFound "user" (idToText uid) - FullyDeletedUser -> - throwError $ - Scim.notFound "user" (idToText uid) - RanDeletionAgain -> - deleteUserInSpar brigUser - else do - deleteUserInSpar brigUser - -- SQPIT-1189: N.B.: this emits a deletion event and then immediately returns - lift $ BrigAccess.delete uid + -- This deletion needs data from the non-deleted User in brig. So, + -- execute it first, then delete the user in brig. Unfortunately, this + -- dependency prevents us from cleaning up users with deleted accounts + -- in brig here in spar. + deleteUserInSpar brigUser + deletionStatus <- lift $ Brig.verifyBrigUserDeletion uid + case deletionStatus of + NoUser -> + throwError $ + Scim.notFound "user" (idToText uid) + FullyDeletedUser -> + throwError $ + Scim.notFound "user" (idToText uid) + RanDeletionAgain -> pure () where deleteUserInSpar :: From 65475bcf3404cf72ff8fc0bd3fe0b7867eeb5549 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 26 Aug 2022 17:48:54 +0200 Subject: [PATCH 10/56] Rename --- libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs | 2 +- libs/wire-api/src/Wire/API/User.hs | 14 +++++++------- services/brig/src/Brig/API/Internal.hs | 6 +++--- services/brig/src/Brig/API/User.hs | 11 +++++------ services/brig/test/integration/API/User/Account.hs | 6 +++--- services/spar/src/Spar/Intra/BrigApp.hs | 6 +++--- services/spar/src/Spar/Scim/User.hs | 8 ++++---- services/spar/src/Spar/Sem/BrigAccess.hs | 4 ++-- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 2 +- 9 files changed, 29 insertions(+), 30 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 47e1a42ca5..ad2e04e8ea 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -157,7 +157,7 @@ type AccountAPI = :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile) ) :<|> Named - "verify-user-deleted" + "ensure-account-deleted" ( "users" :> Capture "uid" UserId :> "verify-deleted" diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index c249a3cd76..4159d1e741 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -1358,7 +1358,7 @@ instance FromJSON DeletionCodeTimeout where parseJSON = A.withObject "DeletionCodeTimeout" $ \o -> DeletionCodeTimeout <$> o A..: "expires_in" -data VerifyAccountDeletedResult = NoUser | FullyDeletedUser | RanDeletionAgain +data VerifyAccountDeletedResult = NoUser | AccountAlreadyDeleted | AccountDeleted deriving (Eq, Show) deriving (S.ToSchema) via (Schema VerifyAccountDeletedResult) @@ -1367,8 +1367,8 @@ instance ToSchema VerifyAccountDeletedResult where enum @Text "VerifyAccountDeletedResult" $ mconcat [ element "no-user" NoUser, - element "fully-deleted-user" FullyDeletedUser, - element "had-to-run-deletion-again" RanDeletionAgain + element "already-deleted" AccountAlreadyDeleted, + element "deleted" AccountDeleted ] instance ToJSON VerifyAccountDeletedResult where @@ -1376,8 +1376,8 @@ instance ToJSON VerifyAccountDeletedResult where where toTag :: VerifyAccountDeletedResult -> A.Value toTag NoUser = "no-user" - toTag FullyDeletedUser = "fully-deleted-user" - toTag RanDeletionAgain = "had-to-run-deletion-again" + toTag AccountAlreadyDeleted = "already-deleted" + toTag AccountDeleted = "deleted" instance FromJSON VerifyAccountDeletedResult where parseJSON (A.Object o) = do @@ -1388,8 +1388,8 @@ instance FromJSON VerifyAccountDeletedResult where where fromTag :: String -> Maybe VerifyAccountDeletedResult fromTag "no-user" = Just NoUser - fromTag "fully-deleted-user" = Just FullyDeletedUser - fromTag "had-to-run-deletion-again" = Just RanDeletionAgain + fromTag "already-deleted" = Just AccountAlreadyDeleted + fromTag "deleted" = Just AccountDeleted fromTag _ = Nothing parseJSON _ = parseFail "Invalid VerifyAccountDeletedResult" diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 25aa7bc24b..bb17136404 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -144,7 +144,7 @@ accountAPI :: accountAPI = Named @"createUserNoVerify" createUserNoVerify :<|> Named @"createUserNoVerifySpar" createUserNoVerifySpar - :<|> Named @"verify-user-deleted" verifyUserDeleted + :<|> Named @"ensure-account-deleted" ensureAccountDeleted teamsAPI :: ServerT BrigIRoutes.TeamsAPI (Handler r) teamsAPI = Named @"updateSearchVisibilityInbound" Index.updateSearchVisibilityInbound @@ -520,8 +520,8 @@ deleteUserNoVerify uid = do >>= ifNothing (errorToWai @'E.UserNotFound) lift $ API.deleteUserNoVerify uid -verifyUserDeleted :: UserId -> (Handler r) VerifyAccountDeletedResult -verifyUserDeleted uid = lift $ wrapHttp $ API.verifyDeleteUserInternal uid +ensureAccountDeleted :: UserId -> (Handler r) VerifyAccountDeletedResult +ensureAccountDeleted uid = lift $ wrapHttp $ API.ensureAccountDeleted uid changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response changeSelfEmailMaybeSendH (u ::: validate ::: req) = do diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index b746d6ca35..2dfc01ba03 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -54,7 +54,7 @@ module Brig.API.User deleteUsersNoVerify, deleteSelfUser, verifyDeleteUser, - verifyDeleteUserInternal, + ensureAccountDeleted, deleteAccount, checkHandles, isBlacklistedHandle, @@ -1233,7 +1233,7 @@ verifyDeleteUser d = do lift . wrapClient $ Code.delete key Code.AccountDeletion -- | Check if `deleteAccount` succeeded and run it again if needed -verifyDeleteUserInternal :: +ensureAccountDeleted :: ( MonadLogger m, MonadCatch m, MonadThrow m, @@ -1249,7 +1249,7 @@ verifyDeleteUserInternal :: ) => UserId -> m VerifyAccountDeletedResult -verifyDeleteUserInternal uid = do +ensureAccountDeleted uid = do mbAcc <- lookupAccount uid case mbAcc of Nothing -> pure NoUser @@ -1269,10 +1269,9 @@ verifyDeleteUserInternal uid = do || conCount > 0 || (not . null) cookies then do - -- TODO: Catch errors? deleteAccount acc - pure RanDeletionAgain - else pure FullyDeletedUser + pure AccountDeleted + else pure AccountAlreadyDeleted -- | Internal deletion without validation. -- diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index f519e1b10e..4fd9b68d35 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1654,7 +1654,7 @@ testVerifyAccountDeletedWithCompletelyDeletedUser brig cannon aws = do ) !!! do const 200 === statusCode - const (Right FullyDeletedUser) === responseJsonEither + const (Right AccountAlreadyDeleted) === responseJsonEither testVerifyAccountDeletedWithNoUser :: Brig -> Http () testVerifyAccountDeletedWithNoUser brig = @@ -1678,7 +1678,7 @@ testVerifyAccountDeletedWithNotDeletedUser brig cannon aws = do ( \uid' -> verifyAccountDeleted brig uid' !!! do const 200 === statusCode - const (Right RanDeletionAgain) === responseJsonEither + const (Right AccountDeleted) === responseJsonEither ) testVerifyAccountDeletedWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () @@ -1708,7 +1708,7 @@ testVerifyAccountDeletedWithDanglingProperty brig cannon aws = do ) !!! do const 200 === statusCode - const (Right RanDeletionAgain) === responseJsonEither + const (Right AccountDeleted) === responseJsonEither getProperty brig (userId u) "foo" !!! do const 404 === statusCode diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index e1099719a1..577e0c35d7 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -34,7 +34,7 @@ module Spar.Intra.BrigApp authorizeScimTokenManagement, parseResponse, giveDefaultHandle, - verifyBrigUserDeletion, + ensureAccountDeletedInBrig, -- * re-exports, mostly for historical reasons and lazyness emailFromSAML, @@ -175,5 +175,5 @@ giveDefaultHandle usr = case userHandle usr of BrigAccess.setHandle uid handle pure handle -verifyBrigUserDeletion :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r VerifyAccountDeletedResult -verifyBrigUserDeletion = BrigAccess.verifyUserDeleted +ensureAccountDeletedInBrig :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r VerifyAccountDeletedResult +ensureAccountDeletedInBrig = BrigAccess.ensureAccountDeleted diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 34a8b3339a..d2a1983992 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -702,7 +702,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = case mbBrigUser of Nothing -> do -- Ensure there's no left-over of this user in brig. - _ <- lift $ Brig.verifyBrigUserDeletion uid + _ <- lift $ Brig.ensureAccountDeletedInBrig uid throwError $ Scim.notFound "user" (idToText uid) Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM @@ -718,15 +718,15 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- dependency prevents us from cleaning up users with deleted accounts -- in brig here in spar. deleteUserInSpar brigUser - deletionStatus <- lift $ Brig.verifyBrigUserDeletion uid + deletionStatus <- lift $ Brig.ensureAccountDeletedInBrig uid case deletionStatus of NoUser -> throwError $ Scim.notFound "user" (idToText uid) - FullyDeletedUser -> + AccountAlreadyDeleted -> throwError $ Scim.notFound "user" (idToText uid) - RanDeletionAgain -> + AccountDeleted -> pure () where deleteUserInSpar :: diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 3d6005e748..acd9451299 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -35,7 +35,7 @@ module Spar.Sem.BrigAccess getRichInfo, checkHandleAvailable, delete, - verifyUserDeleted, + ensureAccountDeleted, ensureReAuthorised, ssoLogin, getStatus, @@ -79,7 +79,7 @@ data BrigAccess m a where GetRichInfo :: UserId -> BrigAccess m RichInfo CheckHandleAvailable :: Handle -> BrigAccess m Bool Delete :: UserId -> BrigAccess m () - VerifyUserDeleted :: UserId -> BrigAccess m VerifyAccountDeletedResult + EnsureAccountDeleted :: UserId -> BrigAccess m VerifyAccountDeletedResult EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () SsoLogin :: UserId -> BrigAccess m SetCookie GetStatus :: UserId -> BrigAccess m AccountStatus diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 354b3b1c0f..0ad0f583ca 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -57,7 +57,7 @@ brigAccessToHttp mgr req = GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu CheckHandleAvailable h -> Intra.checkHandleAvailable h Delete itlu -> Intra.deleteBrigUser itlu - VerifyUserDeleted itlu -> Itra.verifyDeletionBrigUser itlu + EnsureAccountDeleted itlu -> Itra.verifyDeletionBrigUser itlu EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma SsoLogin itlu -> Intra.ssoLogin itlu GetStatus itlu -> Intra.getStatus itlu From 73e1536ffddda16309a428d00794641d6bfffbd3 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Aug 2022 09:58:01 +0200 Subject: [PATCH 11/56] Rename... --- libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs | 2 +- services/brig/test/integration/API/User/Account.hs | 8 ++++---- services/brig/test/integration/API/User/Util.hs | 2 +- services/spar/src/Spar/Intra/Brig.hs | 2 +- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index ad2e04e8ea..7825309a1c 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -160,7 +160,7 @@ type AccountAPI = "ensure-account-deleted" ( "users" :> Capture "uid" UserId - :> "verify-deleted" + :> "ensure-deleted" :> Post '[Servant.JSON] VerifyAccountDeletedResult ) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 4fd9b68d35..a07e8485e9 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -163,7 +163,7 @@ tests _ at opts p b c ch g aws = [ test' aws p "put /users/:uid/email" $ testUpdateUserEmailByTeamOwner b ], testGroup - "/i/users/:uid/verify-deleted" + "/i/users/:uid/ensure-deleted" [ test' aws p "does nothing for completely deleted user" $ testVerifyAccountDeletedWithCompletelyDeletedUser b c aws, test' aws p "does nothing when the uses doesn't exist" $ testVerifyAccountDeletedWithNoUser b, test' aws p "deletes a not deleted user" $ testVerifyAccountDeletedWithNotDeletedUser b c aws, @@ -1650,7 +1650,7 @@ testVerifyAccountDeletedWithCompletelyDeletedUser brig cannon aws = do let uid = userId u post ( brig - . paths ["/i/users", toByteString' uid, "verify-deleted"] + . paths ["/i/users", toByteString' uid, "ensure-deleted"] ) !!! do const 200 === statusCode @@ -1662,7 +1662,7 @@ testVerifyAccountDeletedWithNoUser brig = Right nonExistingUid -> post ( brig - . paths ["/i/users", toByteString' nonExistingUid, "verify-deleted"] + . paths ["/i/users", toByteString' nonExistingUid, "ensure-deleted"] ) !!! do const 200 === statusCode @@ -1704,7 +1704,7 @@ testVerifyAccountDeletedWithDanglingProperty brig cannon aws = do execAndAssertUserDeletion brig cannon u (Handle hdl) [] aws $ \uid' -> do post ( brig - . paths ["/i/users", toByteString' uid', "verify-deleted"] + . paths ["/i/users", toByteString' uid', "ensure-deleted"] ) !!! do const 200 === statusCode diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 9acf2126a8..764370de71 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -580,6 +580,6 @@ verifyAccountDeleted :: (MonadIO m, MonadHttp m) => Brig -> UserId -> m Response verifyAccountDeleted brig uid = post ( brig - . paths ["/i/users", toByteString' uid, "verify-deleted"] + . paths ["/i/users", toByteString' uid, "ensure-deleted"] . expect2xx ) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index b32cda0c4c..3ae755e962 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -372,7 +372,7 @@ verifyDeletionBrigUser buid = do resp <- call $ method POST - . paths ["/i/users", toByteString' buid, "verify-deleted"] + . paths ["/i/users", toByteString' buid, "ensure-deleted"] case statusCode resp of 200 -> parseResponse "brig" resp _ -> rethrow "brig" resp From d1f3a800f312e037b6b27d93379fab24e77fe772 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Aug 2022 10:01:37 +0200 Subject: [PATCH 12/56] Rename --- .../brig/test/integration/API/User/Account.hs | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index a07e8485e9..3964d51e61 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -164,10 +164,10 @@ tests _ at opts p b c ch g aws = ], testGroup "/i/users/:uid/ensure-deleted" - [ test' aws p "does nothing for completely deleted user" $ testVerifyAccountDeletedWithCompletelyDeletedUser b c aws, - test' aws p "does nothing when the uses doesn't exist" $ testVerifyAccountDeletedWithNoUser b, - test' aws p "deletes a not deleted user" $ testVerifyAccountDeletedWithNotDeletedUser b c aws, - test' aws p "delete again because of dangling property" $ testVerifyAccountDeletedWithDanglingProperty b c aws + [ test' aws p "does nothing for completely deleted user" $ testEnsureAccountDeletedWithCompletelyDeletedUser b c aws, + test' aws p "does nothing when the uses doesn't exist" $ testEnsureAccountDeletedWithNoUser b, + test' aws p "deletes a not deleted user" $ testEnsureAccountDeletedWithNotDeletedUser b c aws, + test' aws p "delete again because of dangling property" $ testEnsureAccountDeletedWithDanglingProperty b c aws ] ] @@ -1640,8 +1640,8 @@ testTooManyMembersForLegalhold opts brig = do const 403 === statusCode const (Right "too-many-members-for-legalhold") === fmap Wai.label . responseJsonEither -testVerifyAccountDeletedWithCompletelyDeletedUser :: Brig -> Cannon -> AWS.Env -> Http () -testVerifyAccountDeletedWithCompletelyDeletedUser brig cannon aws = do +testEnsureAccountDeletedWithCompletelyDeletedUser :: Brig -> Cannon -> AWS.Env -> Http () +testEnsureAccountDeletedWithCompletelyDeletedUser brig cannon aws = do u <- randomUser brig liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) setHandleAndDeleteUser brig cannon u [] aws $ @@ -1656,8 +1656,8 @@ testVerifyAccountDeletedWithCompletelyDeletedUser brig cannon aws = do const 200 === statusCode const (Right AccountAlreadyDeleted) === responseJsonEither -testVerifyAccountDeletedWithNoUser :: Brig -> Http () -testVerifyAccountDeletedWithNoUser brig = +testEnsureAccountDeletedWithNoUser :: Brig -> Http () +testEnsureAccountDeletedWithNoUser brig = case parseIdFromText "19166173-49eb-49bc-962f-72c95f27a428" of Right nonExistingUid -> post @@ -1669,8 +1669,8 @@ testVerifyAccountDeletedWithNoUser brig = const (Right NoUser) === responseJsonEither Left _ -> fail "Invalid test data! (This should never happen.)" -testVerifyAccountDeletedWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () -testVerifyAccountDeletedWithNotDeletedUser brig cannon aws = do +testEnsureAccountDeletedWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () +testEnsureAccountDeletedWithNotDeletedUser brig cannon aws = do u <- randomUser brig liftIO $ Util.assertUserJournalQueue "user activate" aws (userActivateJournaled u) do @@ -1681,8 +1681,8 @@ testVerifyAccountDeletedWithNotDeletedUser brig cannon aws = do const (Right AccountDeleted) === responseJsonEither ) -testVerifyAccountDeletedWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () -testVerifyAccountDeletedWithDanglingProperty brig cannon aws = do +testEnsureAccountDeletedWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () +testEnsureAccountDeletedWithDanglingProperty brig cannon aws = do u <- randomUser brig liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) From afaa62fadb0abfaf9d54366194b515ad559f6882 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Aug 2022 10:08:41 +0200 Subject: [PATCH 13/56] Rename --- .../src/Wire/API/Routes/Internal/Brig.hs | 2 +- libs/wire-api/src/Wire/API/User.hs | 20 +++++++++---------- services/brig/src/Brig/API/Internal.hs | 2 +- services/brig/src/Brig/API/User.hs | 2 +- services/spar/src/Spar/Intra/Brig.hs | 2 +- services/spar/src/Spar/Intra/BrigApp.hs | 2 +- services/spar/src/Spar/Sem/BrigAccess.hs | 4 ++-- 7 files changed, 17 insertions(+), 17 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index 7825309a1c..b6cb925a85 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -161,7 +161,7 @@ type AccountAPI = ( "users" :> Capture "uid" UserId :> "ensure-deleted" - :> Post '[Servant.JSON] VerifyAccountDeletedResult + :> Post '[Servant.JSON] EnsureAccountDeletedResult ) -- | The missing ref is implicit by the capture diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 4159d1e741..6367901ed9 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -95,7 +95,7 @@ module Wire.API.User VerifyDeleteUser (..), mkVerifyDeleteUser, DeletionCodeTimeout (..), - VerifyAccountDeletedResult (..), + EnsureAccountDeletedResult (..), -- * List Users ListUsersQuery (..), @@ -1358,40 +1358,40 @@ instance FromJSON DeletionCodeTimeout where parseJSON = A.withObject "DeletionCodeTimeout" $ \o -> DeletionCodeTimeout <$> o A..: "expires_in" -data VerifyAccountDeletedResult = NoUser | AccountAlreadyDeleted | AccountDeleted +data EnsureAccountDeletedResult = NoUser | AccountAlreadyDeleted | AccountDeleted deriving (Eq, Show) - deriving (S.ToSchema) via (Schema VerifyAccountDeletedResult) + deriving (S.ToSchema) via (Schema EnsureAccountDeletedResult) -instance ToSchema VerifyAccountDeletedResult where +instance ToSchema EnsureAccountDeletedResult where schema = - enum @Text "VerifyAccountDeletedResult" $ + enum @Text "EnsureAccountDeletedResult" $ mconcat [ element "no-user" NoUser, element "already-deleted" AccountAlreadyDeleted, element "deleted" AccountDeleted ] -instance ToJSON VerifyAccountDeletedResult where +instance ToJSON EnsureAccountDeletedResult where toJSON t = A.object ["tag" A..= toTag t] where - toTag :: VerifyAccountDeletedResult -> A.Value + toTag :: EnsureAccountDeletedResult -> A.Value toTag NoUser = "no-user" toTag AccountAlreadyDeleted = "already-deleted" toTag AccountDeleted = "deleted" -instance FromJSON VerifyAccountDeletedResult where +instance FromJSON EnsureAccountDeletedResult where parseJSON (A.Object o) = do tagString <- o A..: "tag" case fromTag tagString of Just t -> pure t Nothing -> A.parseFail $ "Unknown tag: " ++ tagString where - fromTag :: String -> Maybe VerifyAccountDeletedResult + fromTag :: String -> Maybe EnsureAccountDeletedResult fromTag "no-user" = Just NoUser fromTag "already-deleted" = Just AccountAlreadyDeleted fromTag "deleted" = Just AccountDeleted fromTag _ = Nothing - parseJSON _ = parseFail "Invalid VerifyAccountDeletedResult" + parseJSON _ = parseFail "Invalid EnsureAccountDeletedResult" data ListUsersQuery = ListUsersByIds [Qualified UserId] diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index bb17136404..77f9d1b1a6 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -520,7 +520,7 @@ deleteUserNoVerify uid = do >>= ifNothing (errorToWai @'E.UserNotFound) lift $ API.deleteUserNoVerify uid -ensureAccountDeleted :: UserId -> (Handler r) VerifyAccountDeletedResult +ensureAccountDeleted :: UserId -> (Handler r) EnsureAccountDeletedResult ensureAccountDeleted uid = lift $ wrapHttp $ API.ensureAccountDeleted uid changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 2dfc01ba03..11cd6d159f 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1248,7 +1248,7 @@ ensureAccountDeleted :: MonadReader Env m ) => UserId -> - m VerifyAccountDeletedResult + m EnsureAccountDeletedResult ensureAccountDeleted uid = do mbAcc <- lookupAccount uid case mbAcc of diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 3ae755e962..1cddcefb64 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -367,7 +367,7 @@ deleteBrigUser buid = do -- | Call brig to verify that a user has been completely deleted. -- Otherwise, do another deletion. -verifyDeletionBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m VerifyAccountDeletedResult +verifyDeletionBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m EnsureAccountDeletedResult verifyDeletionBrigUser buid = do resp <- call $ diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index 577e0c35d7..c78e64137a 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -175,5 +175,5 @@ giveDefaultHandle usr = case userHandle usr of BrigAccess.setHandle uid handle pure handle -ensureAccountDeletedInBrig :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r VerifyAccountDeletedResult +ensureAccountDeletedInBrig :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r EnsureAccountDeletedResult ensureAccountDeletedInBrig = BrigAccess.ensureAccountDeleted diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index acd9451299..4def56a93b 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -55,7 +55,7 @@ import Imports import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie -import Wire.API.User (VerificationAction, VerifyAccountDeletedResult) +import Wire.API.User (EnsureAccountDeletedResult, VerificationAction) import Wire.API.User.Identity import Wire.API.User.Profile import Wire.API.User.RichInfo as RichInfo @@ -79,7 +79,7 @@ data BrigAccess m a where GetRichInfo :: UserId -> BrigAccess m RichInfo CheckHandleAvailable :: Handle -> BrigAccess m Bool Delete :: UserId -> BrigAccess m () - EnsureAccountDeleted :: UserId -> BrigAccess m VerifyAccountDeletedResult + EnsureAccountDeleted :: UserId -> BrigAccess m EnsureAccountDeletedResult EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () SsoLogin :: UserId -> BrigAccess m SetCookie GetStatus :: UserId -> BrigAccess m AccountStatus From 6ef3925cb314b6bba0d3e9d02a0c7db8de5b217a Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Aug 2022 16:25:51 +0200 Subject: [PATCH 14/56] Add changelog --- changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim diff --git a/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim b/changelog.d/3-bug-fixes/more-stable-user-deletion-via-scim new file mode 100644 index 0000000000..bbbca33cab --- /dev/null +++ b/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). From d8ee64acbb8b4200f83a8754d22f64a7f85aba50 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 31 Aug 2022 13:13:38 +0200 Subject: [PATCH 15/56] Simplify. --- services/spar/src/Spar/API.hs | 2 +- services/spar/src/Spar/Intra/Brig.hs | 11 ----------- services/spar/src/Spar/Sem/BrigAccess.hs | 2 -- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 1 - 4 files changed, 1 insertion(+), 15 deletions(-) diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index fefd72221f..3956e41d2d 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -443,8 +443,8 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co when (mUserTeam == Just team) $ do if purge then do - BrigAccess.delete uid SAMLUserStore.delete uid uref + void $ BrigAccess.ensureAccountDeleted uid else do throwSparSem SparIdPHasBoundUsers when (Cas.hasMore page) $ diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 1cddcefb64..d8829656a5 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -30,7 +30,6 @@ module Spar.Intra.Brig setBrigUserRichInfo, setBrigUserLocale, checkHandleAvailable, - deleteBrigUser, verifyDeletionBrigUser, createBrigUserSAML, createBrigUserNoSAML, @@ -355,16 +354,6 @@ checkHandleAvailable hnd = do | otherwise -> rethrow "brig" resp --- | Call brig to delete a user -deleteBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m () -deleteBrigUser buid = do - resp :: ResponseLBS <- - call $ - method DELETE - . paths ["/i/users", toByteString' buid] - unless (statusCode resp == 202) $ - rethrow "brig" resp - -- | Call brig to verify that a user has been completely deleted. -- Otherwise, do another deletion. verifyDeletionBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m EnsureAccountDeletedResult diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 4def56a93b..28ebdd7cf8 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -34,7 +34,6 @@ module Spar.Sem.BrigAccess setLocale, getRichInfo, checkHandleAvailable, - delete, ensureAccountDeleted, ensureReAuthorised, ssoLogin, @@ -78,7 +77,6 @@ data BrigAccess m a where SetLocale :: UserId -> Maybe Locale -> BrigAccess m () GetRichInfo :: UserId -> BrigAccess m RichInfo CheckHandleAvailable :: Handle -> BrigAccess m Bool - Delete :: UserId -> BrigAccess m () EnsureAccountDeleted :: UserId -> BrigAccess m EnsureAccountDeletedResult EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () SsoLogin :: UserId -> BrigAccess m SetCookie diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 0ad0f583ca..25a1563ab2 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -56,7 +56,6 @@ brigAccessToHttp mgr req = SetLocale itlu l -> Intra.setBrigUserLocale itlu l GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu CheckHandleAvailable h -> Intra.checkHandleAvailable h - Delete itlu -> Intra.deleteBrigUser itlu EnsureAccountDeleted itlu -> Itra.verifyDeletionBrigUser itlu EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma SsoLogin itlu -> Intra.ssoLogin itlu From 3f044f7363a42d44d5b1cd7fc72993dbf5926843 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Wed, 31 Aug 2022 13:17:53 +0200 Subject: [PATCH 16/56] Simplify. --- services/spar/src/Spar/Intra/BrigApp.hs | 4 ---- services/spar/src/Spar/Scim/User.hs | 4 ++-- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index c78e64137a..02b518d349 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -34,7 +34,6 @@ module Spar.Intra.BrigApp authorizeScimTokenManagement, parseResponse, giveDefaultHandle, - ensureAccountDeletedInBrig, -- * re-exports, mostly for historical reasons and lazyness emailFromSAML, @@ -174,6 +173,3 @@ giveDefaultHandle usr = case userHandle usr of uid = userId usr BrigAccess.setHandle uid handle pure handle - -ensureAccountDeletedInBrig :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r EnsureAccountDeletedResult -ensureAccountDeletedInBrig = BrigAccess.ensureAccountDeleted diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index d2a1983992..368d1effdd 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -702,7 +702,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = case mbBrigUser of Nothing -> do -- Ensure there's no left-over of this user in brig. - _ <- lift $ Brig.ensureAccountDeletedInBrig uid + _ <- lift $ BrigAccess.ensureAccountDeleted uid throwError $ Scim.notFound "user" (idToText uid) Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM @@ -718,7 +718,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- dependency prevents us from cleaning up users with deleted accounts -- in brig here in spar. deleteUserInSpar brigUser - deletionStatus <- lift $ Brig.ensureAccountDeletedInBrig uid + deletionStatus <- lift $ BrigAccess.ensureAccountDeleted uid case deletionStatus of NoUser -> throwError $ From ba503c37087b7390d2a1fbf90a20c8e6b1c1df58 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 31 Aug 2022 16:21:32 +0200 Subject: [PATCH 17/56] Simplify test setup QuickCheck can provide well-formed UserIds to us. --- .../brig/test/integration/API/User/Account.hs | 21 +++++++++---------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 3964d51e61..5809275b0d 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -73,6 +73,7 @@ import qualified Network.HTTP.Types as Http import qualified Network.Wai as Wai import qualified Network.Wai.Utilities.Error as Error import qualified Network.Wai.Utilities.Error as Wai +import Test.QuickCheck (arbitrary, generate) import Test.Tasty hiding (Timeout) import Test.Tasty.Cannon hiding (Cannon) import qualified Test.Tasty.Cannon as WS @@ -1657,17 +1658,15 @@ testEnsureAccountDeletedWithCompletelyDeletedUser brig cannon aws = do const (Right AccountAlreadyDeleted) === responseJsonEither testEnsureAccountDeletedWithNoUser :: Brig -> Http () -testEnsureAccountDeletedWithNoUser brig = - case parseIdFromText "19166173-49eb-49bc-962f-72c95f27a428" of - Right nonExistingUid -> - post - ( brig - . paths ["/i/users", toByteString' nonExistingUid, "ensure-deleted"] - ) - !!! do - const 200 === statusCode - const (Right NoUser) === responseJsonEither - Left _ -> fail "Invalid test data! (This should never happen.)" +testEnsureAccountDeletedWithNoUser brig = do + nonExistingUid :: UserId <- liftIO $ generate arbitrary + post + ( brig + . paths ["/i/users", toByteString' nonExistingUid, "ensure-deleted"] + ) + !!! do + const 200 === statusCode + const (Right NoUser) === responseJsonEither testEnsureAccountDeletedWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () testEnsureAccountDeletedWithNotDeletedUser brig cannon aws = do From b9c2b252c91cf38046513965d59f4e6a7d1438c9 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 1 Sep 2022 17:31:07 +0200 Subject: [PATCH 18/56] (Re-)use internal deletion endpoint Remove the second one. --- .../src/Wire/API/Routes/Internal/Brig.hs | 7 ---- services/brig/src/Brig/API/Internal.hs | 26 ++++++------ .../brig/test/integration/API/User/Account.hs | 40 +++++++++---------- .../brig/test/integration/API/User/Util.hs | 8 ---- services/spar/src/Spar/Intra/Brig.hs | 12 +++--- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 2 +- 6 files changed, 38 insertions(+), 57 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index b6cb925a85..1c03b4f6e9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -156,13 +156,6 @@ type AccountAPI = :> ReqBody '[Servant.JSON] NewUserSpar :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile) ) - :<|> Named - "ensure-account-deleted" - ( "users" - :> Capture "uid" UserId - :> "ensure-deleted" - :> Post '[Servant.JSON] EnsureAccountDeletedResult - ) -- | The missing ref is implicit by the capture data NewKeyPackageRef = NewKeyPackageRef diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 77f9d1b1a6..bea2108783 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -144,7 +144,6 @@ accountAPI :: accountAPI = Named @"createUserNoVerify" createUserNoVerify :<|> Named @"createUserNoVerifySpar" createUserNoVerifySpar - :<|> Named @"ensure-account-deleted" ensureAccountDeleted teamsAPI :: ServerT BrigIRoutes.TeamsAPI (Handler r) teamsAPI = Named @"updateSearchVisibilityInbound" Index.updateSearchVisibilityInbound @@ -511,14 +510,20 @@ createUserNoVerifySpar uData = deleteUserNoVerifyH :: UserId -> (Handler r) Response deleteUserNoVerifyH uid = do - setStatus status202 empty <$ deleteUserNoVerify uid + r <- ensureAccountDeleted uid + pure $ case r of + NoUser -> setStatus status404 $ json r + AccountAlreadyDeleted -> setStatus status200 $ json r + AccountDeleted -> setStatus status202 $ json r -deleteUserNoVerify :: UserId -> (Handler r) () -deleteUserNoVerify uid = do - void $ - lift (wrapClient $ API.lookupAccount uid) - >>= ifNothing (errorToWai @'E.UserNotFound) - lift $ API.deleteUserNoVerify uid +-- 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 ensureAccountDeleted :: UserId -> (Handler r) EnsureAccountDeletedResult ensureAccountDeleted uid = lift $ wrapHttp $ API.ensureAccountDeleted uid @@ -800,8 +805,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 diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 5809275b0d..a23cf17087 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -164,9 +164,9 @@ tests _ at opts p b c ch g aws = [ test' aws p "put /users/:uid/email" $ testUpdateUserEmailByTeamOwner b ], testGroup - "/i/users/:uid/ensure-deleted" + "delete /i/users/:uid" [ test' aws p "does nothing for completely deleted user" $ testEnsureAccountDeletedWithCompletelyDeletedUser b c aws, - test' aws p "does nothing when the uses doesn't exist" $ testEnsureAccountDeletedWithNoUser b, + test' aws p "does nothing when the user doesn't exist" $ testEnsureAccountDeletedWithNoUser b, test' aws p "deletes a not deleted user" $ testEnsureAccountDeletedWithNotDeletedUser b c aws, test' aws p "delete again because of dangling property" $ testEnsureAccountDeletedWithDanglingProperty b c aws ] @@ -1644,14 +1644,14 @@ testTooManyMembersForLegalhold opts brig = do testEnsureAccountDeletedWithCompletelyDeletedUser :: Brig -> Cannon -> AWS.Env -> Http () testEnsureAccountDeletedWithCompletelyDeletedUser brig cannon aws = do u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) + liftIO $ Util.assertUserJournalQueue "user activate testEnsureAccountDeletedWithCompletelyDeletedUser" aws (userActivateJournaled u) setHandleAndDeleteUser brig cannon u [] aws $ - \uid -> delete (brig . paths ["/i/users", toByteString' uid]) !!! const 202 === statusCode + \uid -> deleteUserInternal uid brig !!! const 202 === statusCode do let uid = userId u - post + delete ( brig - . paths ["/i/users", toByteString' uid, "ensure-deleted"] + . paths ["/i/users", toByteString' uid] ) !!! do const 200 === statusCode @@ -1660,30 +1660,28 @@ testEnsureAccountDeletedWithCompletelyDeletedUser brig cannon aws = do testEnsureAccountDeletedWithNoUser :: Brig -> Http () testEnsureAccountDeletedWithNoUser brig = do nonExistingUid :: UserId <- liftIO $ generate arbitrary - post - ( brig - . paths ["/i/users", toByteString' nonExistingUid, "ensure-deleted"] - ) + deleteUserInternal nonExistingUid brig !!! do - const 200 === statusCode + const 404 === statusCode const (Right NoUser) === responseJsonEither testEnsureAccountDeletedWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () testEnsureAccountDeletedWithNotDeletedUser brig cannon aws = do u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate" aws (userActivateJournaled u) + liftIO $ Util.assertUserJournalQueue "user activate testEnsureAccountDeletedWithNotDeletedUser" aws (userActivateJournaled u) do setHandleAndDeleteUser brig cannon u [] aws $ ( \uid' -> - verifyAccountDeleted brig uid' !!! do - const 200 === statusCode - const (Right AccountDeleted) === responseJsonEither + deleteUserInternal uid' brig + !!! do + const 202 === statusCode + const (Right AccountDeleted) === responseJsonEither ) testEnsureAccountDeletedWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () testEnsureAccountDeletedWithDanglingProperty brig cannon aws = do u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) + liftIO $ Util.assertUserJournalQueue "user activate testEnsureAccountDeletedWithDanglingProperty" aws (userActivateJournaled u) let uid = userId u -- First set a unique handle (to verify freeing of the handle) @@ -1693,6 +1691,7 @@ testEnsureAccountDeletedWithDanglingProperty brig cannon aws = do !!! const 200 === statusCode deleteUserInternal uid brig !!! const 202 === statusCode + liftIO $ Util.assertUserJournalQueue "user deletion testEnsureAccountDeletedWithDanglingProperty" aws (userDeleteJournaled uid) setProperty brig (userId u) "foo" objectProp !!! const 200 === statusCode @@ -1701,12 +1700,9 @@ testEnsureAccountDeletedWithDanglingProperty brig cannon aws = do const (Just objectProp) === responseJsonMaybe execAndAssertUserDeletion brig cannon u (Handle hdl) [] aws $ \uid' -> do - post - ( brig - . paths ["/i/users", toByteString' uid', "ensure-deleted"] - ) + deleteUserInternal uid' brig !!! do - const 200 === statusCode + const 202 === statusCode const (Right AccountDeleted) === responseJsonEither getProperty brig (userId u) "foo" !!! do @@ -1770,7 +1766,7 @@ execAndAssertUserDeletion brig cannon u hdl others aws execDelete = do ] -- This will generate a new event, we need to consume it here usr <- postUserInternal o brig - liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal: " aws (userActivateJournaled usr) + liftIO $ Util.assertUserJournalQueue "user activate execAndAssertUserDeletion" aws (userActivateJournaled usr) -- Handle is available again Bilge.head (brig . paths ["users", "handles", toByteString' hdl] . zUser uid) !!! const 404 === statusCode diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index 764370de71..a2573fc269 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -575,11 +575,3 @@ nonce m brig uid cid = . paths ["clients", toByteString' cid, "nonce"] . zUser uid ) - -verifyAccountDeleted :: (MonadIO m, MonadHttp m) => Brig -> UserId -> m ResponseLBS -verifyAccountDeleted brig uid = - post - ( brig - . paths ["/i/users", toByteString' uid, "ensure-deleted"] - . expect2xx - ) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index d8829656a5..7309eb0075 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -30,7 +30,7 @@ module Spar.Intra.Brig setBrigUserRichInfo, setBrigUserLocale, checkHandleAvailable, - verifyDeletionBrigUser, + deleteBrigUserInternal, createBrigUserSAML, createBrigUserNoSAML, updateEmail, @@ -356,14 +356,14 @@ checkHandleAvailable hnd = do -- | Call brig to verify that a user has been completely deleted. -- Otherwise, do another deletion. -verifyDeletionBrigUser :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m EnsureAccountDeletedResult -verifyDeletionBrigUser buid = do +deleteBrigUserInternal :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m EnsureAccountDeletedResult +deleteBrigUserInternal buid = do resp <- call $ - method POST - . paths ["/i/users", toByteString' buid, "ensure-deleted"] + method DELETE + . paths ["/i/users", toByteString' buid] case statusCode resp of - 200 -> parseResponse "brig" resp + i | i == 200 || i == 202 -> parseResponse "brig" resp _ -> rethrow "brig" resp -- | Verify user's password (needed for certain powerful operations). diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 25a1563ab2..2797e0f463 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -56,7 +56,7 @@ brigAccessToHttp mgr req = SetLocale itlu l -> Intra.setBrigUserLocale itlu l GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu CheckHandleAvailable h -> Intra.checkHandleAvailable h - EnsureAccountDeleted itlu -> Itra.verifyDeletionBrigUser itlu + EnsureAccountDeleted itlu -> Itra.deleteBrigUserInternal itlu EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma SsoLogin itlu -> Intra.ssoLogin itlu GetStatus itlu -> Intra.getStatus itlu From 9b217067e6b4e2b1448892a5f10b5b7317b5b3e9 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 1 Sep 2022 17:48:58 +0200 Subject: [PATCH 19/56] Delete ToSchema instance The data type is only used by a wai-route endpoint. --- libs/wire-api/src/Wire/API/User.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 6367901ed9..2b5db70eb2 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -1360,7 +1360,6 @@ instance FromJSON DeletionCodeTimeout where data EnsureAccountDeletedResult = NoUser | AccountAlreadyDeleted | AccountDeleted deriving (Eq, Show) - deriving (S.ToSchema) via (Schema EnsureAccountDeletedResult) instance ToSchema EnsureAccountDeletedResult where schema = From 43f3133702a2af4f7d19550f2415a8e11ec4f387 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 1 Sep 2022 18:55:27 +0200 Subject: [PATCH 20/56] Handle 404s of non-existing user deletion --- services/spar/src/Spar/Intra/Brig.hs | 6 +++--- .../test-integration/Test/Spar/Intra/BrigSpec.hs | 12 ++++++++++-- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 7309eb0075..66613afc39 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -354,8 +354,8 @@ checkHandleAvailable hnd = do | otherwise -> rethrow "brig" resp --- | Call brig to verify that a user has been completely deleted. --- Otherwise, do another deletion. +-- | Call brig to delete a user. +-- If the user wasn't deleted completely before, another deletion attempt will be made. deleteBrigUserInternal :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m EnsureAccountDeletedResult deleteBrigUserInternal buid = do resp <- @@ -363,7 +363,7 @@ deleteBrigUserInternal buid = do method DELETE . paths ["/i/users", toByteString' buid] case statusCode resp of - i | i == 200 || i == 202 -> parseResponse "brig" resp + i | i == 200 || i == 202 || i == 404 -> parseResponse "brig" resp _ -> rethrow "brig" resp -- | Verify user's password (needed for certain powerful operations). diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs index b400a32e92..cb1b5e0f6f 100644 --- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs @@ -21,13 +21,15 @@ module Test.Spar.Intra.BrigSpec where import Control.Lens ((^.)) -import Data.Id (Id (Id)) +import Data.Id (Id (Id), UserId) import qualified Data.UUID as UUID import Imports hiding (head) import qualified Spar.Intra.BrigApp as Intra +import Spar.Sem.BrigAccess (ensureAccountDeleted) +import Test.QuickCheck import Util import qualified Web.Scim.Schema.User as Scim.User -import Wire.API.User (fromEmail) +import Wire.API.User (EnsureAccountDeletedResult (..), fromEmail) spec :: SpecWith TestEnv spec = do @@ -37,6 +39,12 @@ spec = do it "if a user gets deleted on spar, it will be deleted on brig as well." $ do pendingWith "or deactivated? we should decide what we want here." + describe "deleteBrigUserInternal" $ do + it "does not throw for non-existing users" $ do + uid :: UserId <- liftIO $ generate arbitrary + r <- runSpar $ ensureAccountDeleted uid + liftIO $ r `shouldBe` NoUser + describe "getBrigUser" $ do it "return Nothing if n/a" $ do musr <- runSpar $ Intra.getBrigUser Intra.WithPendingInvitations (Id . fromJust $ UUID.fromText "29546d9e-ed5b-11ea-8228-c324b1ea1030") From a9b334c5089737da87ec259f18d42ae0667991ac Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 1 Sep 2022 19:05:35 +0200 Subject: [PATCH 21/56] Delete superfluous instance --- libs/wire-api/src/Wire/API/User.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 2b5db70eb2..7beaa84a16 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -1361,15 +1361,6 @@ instance FromJSON DeletionCodeTimeout where data EnsureAccountDeletedResult = NoUser | AccountAlreadyDeleted | AccountDeleted deriving (Eq, Show) -instance ToSchema EnsureAccountDeletedResult where - schema = - enum @Text "EnsureAccountDeletedResult" $ - mconcat - [ element "no-user" NoUser, - element "already-deleted" AccountAlreadyDeleted, - element "deleted" AccountDeleted - ] - instance ToJSON EnsureAccountDeletedResult where toJSON t = A.object ["tag" A..= toTag t] where From 2cf01ca68cef25c4fef7bf7750dfdaf5270b502f Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 1 Sep 2022 19:40:23 +0200 Subject: [PATCH 22/56] Rename --- libs/wire-api/src/Wire/API/User.hs | 14 ++++---- services/brig/src/Brig/API/Internal.hs | 14 +------- services/brig/src/Brig/API/User.hs | 2 +- .../brig/test/integration/API/User/Account.hs | 32 +++++++++---------- services/spar/src/Spar/API.hs | 2 +- services/spar/src/Spar/Intra/Brig.hs | 2 +- services/spar/src/Spar/Scim/User.hs | 4 +-- services/spar/src/Spar/Sem/BrigAccess.hs | 6 ++-- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 2 +- .../Test/Spar/Intra/BrigSpec.hs | 6 ++-- 10 files changed, 36 insertions(+), 48 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 7beaa84a16..55ba8f3499 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -95,7 +95,7 @@ module Wire.API.User VerifyDeleteUser (..), mkVerifyDeleteUser, DeletionCodeTimeout (..), - EnsureAccountDeletedResult (..), + DeleteUserResult (..), -- * List Users ListUsersQuery (..), @@ -1358,30 +1358,30 @@ instance FromJSON DeletionCodeTimeout where parseJSON = A.withObject "DeletionCodeTimeout" $ \o -> DeletionCodeTimeout <$> o A..: "expires_in" -data EnsureAccountDeletedResult = NoUser | AccountAlreadyDeleted | AccountDeleted +data DeleteUserResult = NoUser | AccountAlreadyDeleted | AccountDeleted deriving (Eq, Show) -instance ToJSON EnsureAccountDeletedResult where +instance ToJSON DeleteUserResult where toJSON t = A.object ["tag" A..= toTag t] where - toTag :: EnsureAccountDeletedResult -> A.Value + toTag :: DeleteUserResult -> A.Value toTag NoUser = "no-user" toTag AccountAlreadyDeleted = "already-deleted" toTag AccountDeleted = "deleted" -instance FromJSON EnsureAccountDeletedResult where +instance FromJSON DeleteUserResult where parseJSON (A.Object o) = do tagString <- o A..: "tag" case fromTag tagString of Just t -> pure t Nothing -> A.parseFail $ "Unknown tag: " ++ tagString where - fromTag :: String -> Maybe EnsureAccountDeletedResult + fromTag :: String -> Maybe DeleteUserResult fromTag "no-user" = Just NoUser fromTag "already-deleted" = Just AccountAlreadyDeleted fromTag "deleted" = Just AccountDeleted fromTag _ = Nothing - parseJSON _ = parseFail "Invalid EnsureAccountDeletedResult" + parseJSON _ = parseFail "Invalid DeleteUserResult" data ListUsersQuery = ListUsersByIds [Qualified UserId] diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index bea2108783..6c87100f1b 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -510,24 +510,12 @@ createUserNoVerifySpar uData = deleteUserNoVerifyH :: UserId -> (Handler r) Response deleteUserNoVerifyH uid = do - r <- ensureAccountDeleted uid + r <- lift $ wrapHttp $ API.ensureAccountDeleted uid pure $ case r of NoUser -> setStatus status404 $ json r AccountAlreadyDeleted -> setStatus status200 $ json r AccountDeleted -> setStatus status202 $ json r --- 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 - -ensureAccountDeleted :: UserId -> (Handler r) EnsureAccountDeletedResult -ensureAccountDeleted uid = lift $ wrapHttp $ API.ensureAccountDeleted uid - changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response changeSelfEmailMaybeSendH (u ::: validate ::: req) = do email <- euEmail <$> parseJsonBody req diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 11cd6d159f..f15498955a 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1248,7 +1248,7 @@ ensureAccountDeleted :: MonadReader Env m ) => UserId -> - m EnsureAccountDeletedResult + m DeleteUserResult ensureAccountDeleted uid = do mbAcc <- lookupAccount uid case mbAcc of diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index a23cf17087..859380a40e 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -165,10 +165,10 @@ tests _ at opts p b c ch g aws = ], testGroup "delete /i/users/:uid" - [ test' aws p "does nothing for completely deleted user" $ testEnsureAccountDeletedWithCompletelyDeletedUser b c aws, - test' aws p "does nothing when the user doesn't exist" $ testEnsureAccountDeletedWithNoUser b, - test' aws p "deletes a not deleted user" $ testEnsureAccountDeletedWithNotDeletedUser b c aws, - test' aws p "delete again because of dangling property" $ testEnsureAccountDeletedWithDanglingProperty b c aws + [ test' aws p "does nothing for completely deleted user" $ testDeleteUserWithCompletelyDeletedUser b c aws, + test' aws p "does nothing when the user doesn't exist" $ testDeleteUserWithNoUser b, + test' aws p "deletes a not deleted user" $ testDeleteUserWithNotDeletedUser b c aws, + test' aws p "delete again because of dangling property" $ testDeleteUserWithDanglingProperty b c aws ] ] @@ -1641,10 +1641,10 @@ testTooManyMembersForLegalhold opts brig = do const 403 === statusCode const (Right "too-many-members-for-legalhold") === fmap Wai.label . responseJsonEither -testEnsureAccountDeletedWithCompletelyDeletedUser :: Brig -> Cannon -> AWS.Env -> Http () -testEnsureAccountDeletedWithCompletelyDeletedUser brig cannon aws = do +testDeleteUserWithCompletelyDeletedUser :: Brig -> Cannon -> AWS.Env -> Http () +testDeleteUserWithCompletelyDeletedUser brig cannon aws = do u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate testEnsureAccountDeletedWithCompletelyDeletedUser" aws (userActivateJournaled u) + liftIO $ Util.assertUserJournalQueue "user activate testDeleteUserWithCompletelyDeletedUser" aws (userActivateJournaled u) setHandleAndDeleteUser brig cannon u [] aws $ \uid -> deleteUserInternal uid brig !!! const 202 === statusCode do @@ -1657,18 +1657,18 @@ testEnsureAccountDeletedWithCompletelyDeletedUser brig cannon aws = do const 200 === statusCode const (Right AccountAlreadyDeleted) === responseJsonEither -testEnsureAccountDeletedWithNoUser :: Brig -> Http () -testEnsureAccountDeletedWithNoUser brig = do +testDeleteUserWithNoUser :: Brig -> Http () +testDeleteUserWithNoUser brig = do nonExistingUid :: UserId <- liftIO $ generate arbitrary deleteUserInternal nonExistingUid brig !!! do const 404 === statusCode const (Right NoUser) === responseJsonEither -testEnsureAccountDeletedWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () -testEnsureAccountDeletedWithNotDeletedUser brig cannon aws = do +testDeleteUserWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () +testDeleteUserWithNotDeletedUser brig cannon aws = do u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate testEnsureAccountDeletedWithNotDeletedUser" aws (userActivateJournaled u) + liftIO $ Util.assertUserJournalQueue "user activate testDeleteUserWithNotDeletedUser" aws (userActivateJournaled u) do setHandleAndDeleteUser brig cannon u [] aws $ ( \uid' -> @@ -1678,10 +1678,10 @@ testEnsureAccountDeletedWithNotDeletedUser brig cannon aws = do const (Right AccountDeleted) === responseJsonEither ) -testEnsureAccountDeletedWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () -testEnsureAccountDeletedWithDanglingProperty brig cannon aws = do +testDeleteUserWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () +testDeleteUserWithDanglingProperty brig cannon aws = do u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate testEnsureAccountDeletedWithDanglingProperty" aws (userActivateJournaled u) + liftIO $ Util.assertUserJournalQueue "user activate testDeleteUserWithDanglingProperty" aws (userActivateJournaled u) let uid = userId u -- First set a unique handle (to verify freeing of the handle) @@ -1691,7 +1691,7 @@ testEnsureAccountDeletedWithDanglingProperty brig cannon aws = do !!! const 200 === statusCode deleteUserInternal uid brig !!! const 202 === statusCode - liftIO $ Util.assertUserJournalQueue "user deletion testEnsureAccountDeletedWithDanglingProperty" aws (userDeleteJournaled uid) + liftIO $ Util.assertUserJournalQueue "user deletion testDeleteUserWithDanglingProperty" aws (userDeleteJournaled uid) setProperty brig (userId u) "foo" objectProp !!! const 200 === statusCode diff --git a/services/spar/src/Spar/API.hs b/services/spar/src/Spar/API.hs index 3956e41d2d..0a81b08c3a 100644 --- a/services/spar/src/Spar/API.hs +++ b/services/spar/src/Spar/API.hs @@ -444,7 +444,7 @@ idpDelete mbzusr idpid (fromMaybe False -> purge) = withDebugLog "idpDelete" (co if purge then do SAMLUserStore.delete uid uref - void $ BrigAccess.ensureAccountDeleted uid + void $ BrigAccess.deleteUser uid else do throwSparSem SparIdPHasBoundUsers when (Cas.hasMore page) $ diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 66613afc39..cde113cfc2 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -356,7 +356,7 @@ checkHandleAvailable hnd = do -- | Call brig to delete a user. -- If the user wasn't deleted completely before, another deletion attempt will be made. -deleteBrigUserInternal :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m EnsureAccountDeletedResult +deleteBrigUserInternal :: (HasCallStack, MonadSparToBrig m, MonadIO m) => UserId -> m DeleteUserResult deleteBrigUserInternal buid = do resp <- call $ diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 368d1effdd..a1ca75b73d 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -702,7 +702,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = case mbBrigUser of Nothing -> do -- Ensure there's no left-over of this user in brig. - _ <- lift $ BrigAccess.ensureAccountDeleted uid + _ <- lift $ BrigAccess.deleteUser uid throwError $ Scim.notFound "user" (idToText uid) Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM @@ -718,7 +718,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- dependency prevents us from cleaning up users with deleted accounts -- in brig here in spar. deleteUserInSpar brigUser - deletionStatus <- lift $ BrigAccess.ensureAccountDeleted uid + deletionStatus <- lift $ BrigAccess.deleteUser uid case deletionStatus of NoUser -> throwError $ diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 28ebdd7cf8..4e7fbbc25a 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -34,7 +34,7 @@ module Spar.Sem.BrigAccess setLocale, getRichInfo, checkHandleAvailable, - ensureAccountDeleted, + deleteUser, ensureReAuthorised, ssoLogin, getStatus, @@ -54,7 +54,7 @@ import Imports import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie -import Wire.API.User (EnsureAccountDeletedResult, VerificationAction) +import Wire.API.User (DeleteUserResult, VerificationAction) import Wire.API.User.Identity import Wire.API.User.Profile import Wire.API.User.RichInfo as RichInfo @@ -77,7 +77,7 @@ data BrigAccess m a where SetLocale :: UserId -> Maybe Locale -> BrigAccess m () GetRichInfo :: UserId -> BrigAccess m RichInfo CheckHandleAvailable :: Handle -> BrigAccess m Bool - EnsureAccountDeleted :: UserId -> BrigAccess m EnsureAccountDeletedResult + DeleteUser :: UserId -> BrigAccess m DeleteUserResult EnsureReAuthorised :: Maybe UserId -> Maybe PlainTextPassword -> Maybe Code.Value -> Maybe VerificationAction -> BrigAccess m () SsoLogin :: UserId -> BrigAccess m SetCookie GetStatus :: UserId -> BrigAccess m AccountStatus diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 2797e0f463..6637b63614 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -56,7 +56,7 @@ brigAccessToHttp mgr req = SetLocale itlu l -> Intra.setBrigUserLocale itlu l GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu CheckHandleAvailable h -> Intra.checkHandleAvailable h - EnsureAccountDeleted itlu -> Itra.deleteBrigUserInternal itlu + DeleteUser itlu -> Itra.deleteBrigUserInternal itlu EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma SsoLogin itlu -> Intra.ssoLogin itlu GetStatus itlu -> Intra.getStatus itlu diff --git a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs index cb1b5e0f6f..822a4ee99b 100644 --- a/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test-integration/Test/Spar/Intra/BrigSpec.hs @@ -25,11 +25,11 @@ import Data.Id (Id (Id), UserId) import qualified Data.UUID as UUID import Imports hiding (head) import qualified Spar.Intra.BrigApp as Intra -import Spar.Sem.BrigAccess (ensureAccountDeleted) +import qualified Spar.Sem.BrigAccess as BrigAccess import Test.QuickCheck import Util import qualified Web.Scim.Schema.User as Scim.User -import Wire.API.User (EnsureAccountDeletedResult (..), fromEmail) +import Wire.API.User (DeleteUserResult (..), fromEmail) spec :: SpecWith TestEnv spec = do @@ -42,7 +42,7 @@ spec = do describe "deleteBrigUserInternal" $ do it "does not throw for non-existing users" $ do uid :: UserId <- liftIO $ generate arbitrary - r <- runSpar $ ensureAccountDeleted uid + r <- runSpar $ BrigAccess.deleteUser uid liftIO $ r `shouldBe` NoUser describe "getBrigUser" $ do From fa5312934e5058a3ee3859aa91cb2249fc143f42 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 2 Sep 2022 07:52:10 +0200 Subject: [PATCH 23/56] Better comments --- services/brig/src/Brig/API/User.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index f15498955a..2e468414bf 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1233,6 +1233,7 @@ verifyDeleteUser d = do lift . wrapClient $ Code.delete key Code.AccountDeletion -- | Check if `deleteAccount` succeeded and run it again if needed +-- Called via @delete /i/user/:uid@. ensureAccountDeleted :: ( MonadLogger m, MonadCatch m, @@ -1275,9 +1276,9 @@ ensureAccountDeleted uid = do -- | 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. +-- 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 From 71d09cdeea06c47d199d6d2acbbcf161030d5b58 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 2 Sep 2022 09:59:09 +0200 Subject: [PATCH 24/56] Remove duplicated test --- services/brig/test/integration/API/User/Account.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 859380a40e..606cbda29e 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -150,7 +150,6 @@ tests _ at opts p b c ch g aws = test' aws p "delete/with-legalhold" $ testDeleteUserWithLegalHold b c aws, test' aws p "delete/by-code" $ testDeleteUserByCode b, test' aws p "delete/anonymous" $ testDeleteAnonUser b, - test' aws p "delete /i/users/:uid - 202" $ testDeleteInternal b c aws, test' aws p "delete with profile pic" $ testDeleteWithProfilePic b ch, test' aws p "delete with connected remote users" $ testDeleteWithRemotes opts b, test' aws p "delete with connected remote users and failed remote notifcations" $ testDeleteWithRemotesAndFailedNotifications opts b c, @@ -1345,13 +1344,6 @@ testDeleteAnonUser brig = do deleteUser uid Nothing brig !!! const 200 === statusCode -testDeleteInternal :: Brig -> Cannon -> AWS.Env -> Http () -testDeleteInternal brig cannon aws = do - u <- randomUser brig - liftIO $ Util.assertUserJournalQueue "user activate testDeleteInternal1: " aws (userActivateJournaled u) - setHandleAndDeleteUser brig cannon u [] aws $ - \uid -> delete (brig . paths ["/i/users", toByteString' uid]) !!! const 202 === statusCode - testDeleteWithProfilePic :: Brig -> CargoHold -> Http () testDeleteWithProfilePic brig cargohold = do uid <- userId <$> createAnonUser "anon" brig From 50120a03ff825478fb837068cae4a26a5bab6494 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 2 Sep 2022 09:59:31 +0200 Subject: [PATCH 25/56] Use helper function to reduce duplication --- services/brig/test/integration/API/User/Account.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 606cbda29e..67874738e6 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1641,10 +1641,7 @@ testDeleteUserWithCompletelyDeletedUser brig cannon aws = do \uid -> deleteUserInternal uid brig !!! const 202 === statusCode do let uid = userId u - delete - ( brig - . paths ["/i/users", toByteString' uid] - ) + deleteUserInternal uid brig !!! do const 200 === statusCode const (Right AccountAlreadyDeleted) === responseJsonEither From 1338ec790b3652ee74d0c8cca40188eb39306bd2 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 2 Sep 2022 10:30:21 +0200 Subject: [PATCH 26/56] Undo accidental change --- services/brig/test/integration/API/User/Account.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 67874738e6..13a242f23e 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1592,7 +1592,7 @@ testRestrictedUserCreation opts brig = do ] postUserRegister' ssoUser brig !!! const 400 === statusCode --- FUTUREWORK: @setRestrictUserCreation@ perhaps needs to be tested in one place only, since it's the +-- | FUTUREWORK: @setRestrictUserCreation@ perhaps needs to be tested in one place only, since it's the -- first thing that we check on the /register endpoint. Other tests that make use of @setRestrictUserCreation@ -- can probably be removed and simplified. It's probably a good candidate for Quickcheck. testTooManyMembersForLegalhold :: Opt.Opts -> Brig -> Http () From f6024fdf52ba38aa077c66b63a6d2624ba773d9b Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 2 Sep 2022 12:08:40 +0200 Subject: [PATCH 27/56] Remove GetAccountIncludeAll Additionally, explain why it's not needed. --- services/spar/src/Spar/Intra/Brig.hs | 25 ------------------- services/spar/src/Spar/Intra/BrigApp.hs | 4 --- services/spar/src/Spar/Scim/User.hs | 7 +++++- services/spar/src/Spar/Sem/BrigAccess.hs | 3 --- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 1 - 5 files changed, 6 insertions(+), 34 deletions(-) diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index cde113cfc2..b5bc4099fc 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -19,7 +19,6 @@ module Spar.Intra.Brig ( MonadSparToBrig (..), getBrigUserAccount, - getBrigUserAccountIncludeAll, getBrigUserByHandle, getBrigUserByEmail, getBrigUserRichInfo, @@ -184,30 +183,6 @@ getBrigUserAccount havePending buid = do 404 -> pure Nothing _ -> rethrow "brig" resp --- | Get a user; returns 'Nothing' if the user was not found. --- Includes users with deleted accounts and pending invitations. -getBrigUserAccountIncludeAll :: (HasCallStack, MonadSparToBrig m) => UserId -> m (Maybe UserAccount) -getBrigUserAccountIncludeAll buid = do - resp :: ResponseLBS <- - call $ - method GET - . paths ["/i/users"] - . query - [ ("ids", Just $ toByteString' buid), - ( "includePendingInvitations", - Just $ toByteString' True - ) - ] - - case statusCode resp of - 200 -> - parseResponse @[UserAccount] "brig" resp >>= \case - [account] -> - pure $ Just account - _ -> pure Nothing - 404 -> pure Nothing - _ -> rethrow "brig" resp - -- | Get a user; returns 'Nothing' if the user was not found. -- -- TODO: currently this is not used, but it might be useful later when/if diff --git a/services/spar/src/Spar/Intra/BrigApp.hs b/services/spar/src/Spar/Intra/BrigApp.hs index 02b518d349..6043970a05 100644 --- a/services/spar/src/Spar/Intra/BrigApp.hs +++ b/services/spar/src/Spar/Intra/BrigApp.hs @@ -28,7 +28,6 @@ module Spar.Intra.BrigApp renderValidExternalId, HavePendingInvitations (..), getBrigUser, - getBrigUserIncludeAll, getBrigUserTeam, getZUsrCheckPerm, authorizeScimTokenManagement, @@ -116,9 +115,6 @@ renderValidExternalId = runValidExternalIdEither urefToExternalId (Just . fromEm getBrigUser :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe User) getBrigUser ifpend = (accountUser <$$>) . BrigAccess.getAccount ifpend -getBrigUserIncludeAll :: (HasCallStack, Member BrigAccess r) => UserId -> Sem r (Maybe User) -getBrigUserIncludeAll = (accountUser <$$>) . BrigAccess.getAccountIncludeAll - -- | Check that an id maps to an user on brig that is 'Active' (or optionally -- 'PendingInvitation') and has a team id. getBrigUserTeam :: (HasCallStack, Member BrigAccess r) => HavePendingInvitations -> UserId -> Sem r (Maybe TeamId) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index a1ca75b73d..3a16de0842 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -42,6 +42,7 @@ module Spar.Scim.User where import Brig.Types.Intra (AccountStatus, UserAccount (accountStatus, accountUser)) +import Brig.Types.User (HavePendingInvitations (..)) import qualified Control.Applicative as Applicative (empty) import Control.Lens (view, (^.)) import Control.Monad.Error.Class (MonadError) @@ -698,7 +699,11 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = ) (const id) $ do - mbBrigUser <- lift $ Brig.getBrigUserIncludeAll uid + -- `getBrigUser` does not include deleted users. However, these + -- ("tombstones") would not have the needed values (`userIdentity = + -- Nothing`) to delete a user in spar. I.e. `SAML.UserRef` and `Email` + -- cannot be figured out when a `User` has status `Deleted`. + mbBrigUser <- lift $ Brig.getBrigUser WithPendingInvitations uid case mbBrigUser of Nothing -> do -- Ensure there's no left-over of this user in brig. diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 4e7fbbc25a..0e35976d5a 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -23,7 +23,6 @@ module Spar.Sem.BrigAccess createNoSAML, updateEmail, getAccount, - getAccountIncludeAll, getByHandle, getByEmail, setName, @@ -65,8 +64,6 @@ data BrigAccess m a where CreateNoSAML :: Email -> TeamId -> Name -> Maybe Locale -> BrigAccess m UserId UpdateEmail :: UserId -> Email -> BrigAccess m () GetAccount :: HavePendingInvitations -> UserId -> BrigAccess m (Maybe UserAccount) - -- | Includes deleted accounts and those with pending invitation - GetAccountIncludeAll :: UserId -> BrigAccess m (Maybe UserAccount) GetByHandle :: Handle -> BrigAccess m (Maybe UserAccount) GetByEmail :: Email -> BrigAccess m (Maybe UserAccount) SetName :: UserId -> Name -> BrigAccess m () diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 6637b63614..98cf588904 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -45,7 +45,6 @@ brigAccessToHttp mgr req = CreateNoSAML e itlt n ml -> Intra.createBrigUserNoSAML e itlt n ml UpdateEmail itlu e -> Intra.updateEmail itlu e GetAccount h itlu -> Intra.getBrigUserAccount h itlu - GetAccountIncludeAll h -> Intra.getBrigUserAccountIncludeAll h GetByHandle h -> Intra.getBrigUserByHandle h GetByEmail e -> Intra.getBrigUserByEmail e SetName itlu n -> Intra.setBrigUserName itlu n From c27de57138728cc45ac9dd63645c0ebb7a9dbfcd Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 10:21:26 +0200 Subject: [PATCH 28/56] Add unit test --- services/spar/spar.cabal | 1 + services/spar/src/Spar/Scim/User.hs | 1 + .../spar/src/Spar/Sem/SAMLUserStore/Mem.hs | 1 + services/spar/test/Test/Spar/Scim/UserSpec.hs | 126 ++++++++++++++++++ 4 files changed, 129 insertions(+) create mode 100644 services/spar/test/Test/Spar/Scim/UserSpec.hs diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 9cb59ca37e..655f2b3401 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -748,6 +748,7 @@ test-suite spec Test.Spar.DataSpec Test.Spar.Intra.BrigSpec Test.Spar.Roundtrip.ByteString + Test.Spar.Scim.UserSpec Test.Spar.ScimSpec Test.Spar.Sem.DefaultSsoCodeSpec Test.Spar.Sem.IdPRawMetadataStoreSpec diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 3a16de0842..ad44feaed2 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -38,6 +38,7 @@ module Spar.Scim.User toScimStoredUser', mkValidExternalId, scimFindUserByEmail, + deleteScimUser, ) where diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs index 8e66f0e732..ed3fcb459a 100644 --- a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs @@ -19,6 +19,7 @@ module Spar.Sem.SAMLUserStore.Mem ( samlUserStoreToMem, + UserRefOrd, ) where diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs new file mode 100644 index 0000000000..d7c0921ccf --- /dev/null +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -0,0 +1,126 @@ +module Test.Spar.Scim.UserSpec where + +import Arbitrary () +import Brig.Types.Intra (AccountStatus (Deleted), UserAccount (..)) +import Brig.Types.User +import Control.Monad.Except (runExceptT) +import Data.Id +import qualified Data.Json.Util +import Imports +import Polysemy +import Polysemy.TinyLog +import Spar.Scim.User (deleteScimUser) +import Spar.Sem.BrigAccess +import Spar.Sem.IdPConfigStore +import Spar.Sem.IdPConfigStore.Mem (TypedState, idPToMem) +import Spar.Sem.SAMLUserStore +import Spar.Sem.SAMLUserStore.Mem (UserRefOrd, samlUserStoreToMem) +import Spar.Sem.ScimExternalIdStore +import Spar.Sem.ScimExternalIdStore.Mem (scimExternalIdStoreToMem) +import Spar.Sem.ScimUserTimesStore +import Spar.Sem.ScimUserTimesStore.Mem (scimUserTimesStoreToMem) +import System.Logger (Msg) +import Test.Hspec +import Test.QuickCheck +import qualified Web.Scim.Handler as Scim +import Web.Scim.Schema.Error (ScimError (..)) +import Wire.API.User +import qualified Wire.API.User.Identity +import Wire.Sem.Logger.TinyLog (discardTinyLogs) + +spec :: Spec +spec = describe "deleteScimUser" $ do + it "runs deletion for deleted brig users again" $ do + uid <- generate arbitrary + tokenInfo <- generate arbitrary + void $ (simulateDeletedBrigUser . toSem) $ deleteScimUser tokenInfo uid + +toSem :: + forall (r :: EffectRow). + Members + '[ Logger (Msg -> Msg), + BrigAccess, + ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore, + IdPConfigStore + ] + r => + Scim.ScimHandler (Sem r) () -> + Sem r (Either ScimError ()) +toSem = runExceptT + +type Effs = + '[ BrigAccess, + IdPConfigStore, + SAMLUserStore, + ScimUserTimesStore, + ScimExternalIdStore, + Logger (Msg -> Msg), + Embed IO, + Final IO + ] + +type InterpreterState = + ( Map (Data.Id.TeamId, Wire.API.User.Identity.Email) Data.Id.UserId, + ( Map Data.Id.UserId (Data.Json.Util.UTCTimeMillis, Data.Json.Util.UTCTimeMillis), + ( Map UserRefOrd UserId, + (Spar.Sem.IdPConfigStore.Mem.TypedState, Either ScimError ()) + ) + ) + ) + +simulateDeletedBrigUser :: + Sem Effs (Either ScimError ()) -> + IO InterpreterState +simulateDeletedBrigUser = + runFinal + . embedToFinal @IO + . discardTinyLogs + . scimExternalIdStoreToMem + . scimUserTimesStoreToMem + . samlUserStoreToMem + . idPToMem + . mockBrigForDeletedUser + +mockBrigForDeletedUser :: + forall (r1 :: EffectRow). + Members + '[ Logger (Msg -> Msg), + ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore, + IdPConfigStore, + Embed IO + ] + r1 => + Sem (BrigAccess ': r1) (Either ScimError ()) -> + Sem r1 (Either ScimError ()) +mockBrigForDeletedUser = interpret $ \case + (GetAccount WithPendingInvitations uid) -> do + userAcc <- liftIO $ someUserAccountTombstone uid + pure $ Just userAcc + (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountDeleted + _ -> do + liftIO $ expectationFailure $ "Unexpected effect (call to brig)" + error "Make typechecker happy. This won't be reached." + where + someUserAccountTombstone :: UserId -> IO UserAccount + someUserAccountTombstone uid = do + user <- generate arbitrary + pure $ + UserAccount + { accountStatus = Deleted, + accountUser = + user + { userDisplayName = Name "default", + userAccentId = defaultAccentId, + userPict = noPict, + userAssets = [], + userHandle = Nothing, + userLocale = defLoc, + userIdentity = Nothing, + userId = uid + } + } + defLoc = fromJust $ parseLocale "De-de" From 93d29f38d297a5384c901af0b156d665ba1709c0 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 10:34:29 +0200 Subject: [PATCH 29/56] Gibt realistic answer in brig call --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 25 +------------------ 1 file changed, 1 insertion(+), 24 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index d7c0921ccf..026a22002d 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -1,7 +1,6 @@ module Test.Spar.Scim.UserSpec where import Arbitrary () -import Brig.Types.Intra (AccountStatus (Deleted), UserAccount (..)) import Brig.Types.User import Control.Monad.Except (runExceptT) import Data.Id @@ -97,30 +96,8 @@ mockBrigForDeletedUser :: Sem (BrigAccess ': r1) (Either ScimError ()) -> Sem r1 (Either ScimError ()) mockBrigForDeletedUser = interpret $ \case - (GetAccount WithPendingInvitations uid) -> do - userAcc <- liftIO $ someUserAccountTombstone uid - pure $ Just userAcc + (GetAccount WithPendingInvitations _) -> pure Nothing (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountDeleted _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Make typechecker happy. This won't be reached." - where - someUserAccountTombstone :: UserId -> IO UserAccount - someUserAccountTombstone uid = do - user <- generate arbitrary - pure $ - UserAccount - { accountStatus = Deleted, - accountUser = - user - { userDisplayName = Name "default", - userAccentId = defaultAccentId, - userPict = noPict, - userAssets = [], - userHandle = Nothing, - userLocale = defLoc, - userIdentity = Nothing, - userId = uid - } - } - defLoc = fromJust $ parseLocale "De-de" From f7efa514e58867f345ee08a3af5ce26a53e7660c Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 11:00:07 +0200 Subject: [PATCH 30/56] Check handler results --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 68 ++++++++++++++++++- 1 file changed, 66 insertions(+), 2 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 026a22002d..0f60b618b6 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -1,6 +1,7 @@ module Test.Spar.Scim.UserSpec where import Arbitrary () +import Brig.Types.Intra import Brig.Types.User import Control.Monad.Except (runExceptT) import Data.Id @@ -22,7 +23,7 @@ import System.Logger (Msg) import Test.Hspec import Test.QuickCheck import qualified Web.Scim.Handler as Scim -import Web.Scim.Schema.Error (ScimError (..)) +import Web.Scim.Schema.Error import Wire.API.User import qualified Wire.API.User.Identity import Wire.Sem.Logger.TinyLog (discardTinyLogs) @@ -32,7 +33,13 @@ spec = describe "deleteScimUser" $ do it "runs deletion for deleted brig users again" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary - void $ (simulateDeletedBrigUser . toSem) $ deleteScimUser tokenInfo uid + r <- (simulateDeletedBrigUser . toSem) $ deleteScimUser tokenInfo uid + handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) + it "returns no error when the account was deleted for the first time" $ do + uid <- generate arbitrary + tokenInfo <- generate arbitrary + r <- (simulateActiveBrigUser . toSem) $ deleteScimUser tokenInfo uid + handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) toSem :: forall (r :: EffectRow). @@ -69,6 +76,9 @@ type InterpreterState = ) ) +handlerResult :: InterpreterState -> Either ScimError () +handlerResult = snd . snd . snd . snd + simulateDeletedBrigUser :: Sem Effs (Either ScimError ()) -> IO InterpreterState @@ -97,7 +107,61 @@ mockBrigForDeletedUser :: Sem r1 (Either ScimError ()) mockBrigForDeletedUser = interpret $ \case (GetAccount WithPendingInvitations _) -> pure Nothing + (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountAlreadyDeleted + _ -> do + liftIO $ expectationFailure $ "Unexpected effect (call to brig)" + error "Make typechecker happy. This won't be reached." + +simulateActiveBrigUser :: + Sem Effs (Either ScimError ()) -> + IO InterpreterState +simulateActiveBrigUser = + runFinal + . embedToFinal @IO + . discardTinyLogs + . scimExternalIdStoreToMem + . scimUserTimesStoreToMem + . samlUserStoreToMem + . idPToMem + . mockBrigForDeletedUser + +mockBrigForActiveUser :: + forall (r1 :: EffectRow). + Members + '[ Logger (Msg -> Msg), + ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore, + IdPConfigStore, + Embed IO + ] + r1 => + Sem (BrigAccess ': r1) (Either ScimError ()) -> + Sem r1 (Either ScimError ()) +mockBrigForActiveUser = interpret $ \case + (GetAccount WithPendingInvitations uid) -> do + acc <- liftIO $ someActiveUser uid + pure $ Just acc (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountDeleted _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Make typechecker happy. This won't be reached." + where + someActiveUser uid = do + user <- generate arbitrary + pure $ + UserAccount + { accountStatus = Active, + accountUser = + user + { userDisplayName = Name "default", + userAccentId = defaultAccentId, + userPict = noPict, + userAssets = [], + userHandle = Nothing, + userLocale = defLoc, + userIdentity = Nothing, + userId = uid + } + } + defLoc = fromJust $ parseLocale "De-de" From 11156ce09c459d79c4993fe1b11f96109cf7c162 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 13:49:50 +0200 Subject: [PATCH 31/56] Test successful user deletion --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 0f60b618b6..f1dc53033a 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -26,6 +26,7 @@ import qualified Web.Scim.Handler as Scim import Web.Scim.Schema.Error import Wire.API.User import qualified Wire.API.User.Identity +import Wire.API.User.Scim import Wire.Sem.Logger.TinyLog (discardTinyLogs) spec :: Spec @@ -38,8 +39,10 @@ spec = describe "deleteScimUser" $ do it "returns no error when the account was deleted for the first time" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary - r <- (simulateActiveBrigUser . toSem) $ deleteScimUser tokenInfo uid - handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) + r <- simulateActiveBrigUser tokenInfo . toSem $ deleteScimUser tokenInfo uid + handlerResult r `shouldBe` Right () + +-- handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) toSem :: forall (r :: EffectRow). @@ -113,9 +116,10 @@ mockBrigForDeletedUser = interpret $ \case error "Make typechecker happy. This won't be reached." simulateActiveBrigUser :: + ScimTokenInfo -> Sem Effs (Either ScimError ()) -> IO InterpreterState -simulateActiveBrigUser = +simulateActiveBrigUser tokenInfo = runFinal . embedToFinal @IO . discardTinyLogs @@ -123,7 +127,7 @@ simulateActiveBrigUser = . scimUserTimesStoreToMem . samlUserStoreToMem . idPToMem - . mockBrigForDeletedUser + . mockBrigForActiveUser tokenInfo mockBrigForActiveUser :: forall (r1 :: EffectRow). @@ -136,9 +140,10 @@ mockBrigForActiveUser :: Embed IO ] r1 => + ScimTokenInfo -> Sem (BrigAccess ': r1) (Either ScimError ()) -> Sem r1 (Either ScimError ()) -mockBrigForActiveUser = interpret $ \case +mockBrigForActiveUser tokenInfo = interpret $ \case (GetAccount WithPendingInvitations uid) -> do acc <- liftIO $ someActiveUser uid pure $ Just acc @@ -161,7 +166,8 @@ mockBrigForActiveUser = interpret $ \case userHandle = Nothing, userLocale = defLoc, userIdentity = Nothing, - userId = uid + userId = uid, + userTeam = Just $ stiTeam tokenInfo } } defLoc = fromJust $ parseLocale "De-de" From fa82c5b23928cabb641b05fcd373a31bc1814848 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 14:00:01 +0200 Subject: [PATCH 32/56] Add test case for partial deleted account --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index f1dc53033a..6095075f08 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -39,10 +39,13 @@ spec = describe "deleteScimUser" $ do it "returns no error when the account was deleted for the first time" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary - r <- simulateActiveBrigUser tokenInfo . toSem $ deleteScimUser tokenInfo uid + r <- simulateActiveBrigUser tokenInfo AccountDeleted . toSem $ deleteScimUser tokenInfo uid handlerResult r `shouldBe` Right () - --- handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) + it "returns an error when the account was partitially(!) deleted before" $ do + uid <- generate arbitrary + tokenInfo <- generate arbitrary + r <- simulateActiveBrigUser tokenInfo AccountAlreadyDeleted . toSem $ deleteScimUser tokenInfo uid + handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) toSem :: forall (r :: EffectRow). @@ -117,9 +120,10 @@ mockBrigForDeletedUser = interpret $ \case simulateActiveBrigUser :: ScimTokenInfo -> + DeleteUserResult -> Sem Effs (Either ScimError ()) -> IO InterpreterState -simulateActiveBrigUser tokenInfo = +simulateActiveBrigUser tokenInfo deletionResult = runFinal . embedToFinal @IO . discardTinyLogs @@ -127,7 +131,7 @@ simulateActiveBrigUser tokenInfo = . scimUserTimesStoreToMem . samlUserStoreToMem . idPToMem - . mockBrigForActiveUser tokenInfo + . mockBrigForActiveUser tokenInfo deletionResult mockBrigForActiveUser :: forall (r1 :: EffectRow). @@ -141,13 +145,14 @@ mockBrigForActiveUser :: ] r1 => ScimTokenInfo -> + DeleteUserResult -> Sem (BrigAccess ': r1) (Either ScimError ()) -> Sem r1 (Either ScimError ()) -mockBrigForActiveUser tokenInfo = interpret $ \case +mockBrigForActiveUser tokenInfo deletionResult = interpret $ \case (GetAccount WithPendingInvitations uid) -> do acc <- liftIO $ someActiveUser uid pure $ Just acc - (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountDeleted + (Spar.Sem.BrigAccess.DeleteUser _) -> pure deletionResult _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Make typechecker happy. This won't be reached." From 055b2bca2bc85ced90383d088876433295faf151 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 15:52:01 +0200 Subject: [PATCH 33/56] Assure that deletion is spar is executed --- .../spar/src/Spar/Sem/SAMLUserStore/Mem.hs | 2 +- services/spar/test/Test/Spar/Scim/UserSpec.hs | 117 +++++++++++------- 2 files changed, 70 insertions(+), 49 deletions(-) diff --git a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs index ed3fcb459a..131ae26681 100644 --- a/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs +++ b/services/spar/src/Spar/Sem/SAMLUserStore/Mem.hs @@ -34,7 +34,7 @@ import qualified SAML2.WebSSO as SAML import Spar.Sem.SAMLUserStore newtype UserRefOrd = UserRefOrd {unUserRefOrd :: SAML.UserRef} - deriving (Eq) + deriving (Eq, Show) instance Ord UserRefOrd where compare (UserRefOrd (SAML.UserRef is ni)) (UserRefOrd (SAML.UserRef is' ni')) = diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 6095075f08..ef7ef79550 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -15,7 +15,7 @@ import Spar.Sem.IdPConfigStore import Spar.Sem.IdPConfigStore.Mem (TypedState, idPToMem) import Spar.Sem.SAMLUserStore import Spar.Sem.SAMLUserStore.Mem (UserRefOrd, samlUserStoreToMem) -import Spar.Sem.ScimExternalIdStore +import qualified Spar.Sem.ScimExternalIdStore as ScimExternalIdStore import Spar.Sem.ScimExternalIdStore.Mem (scimExternalIdStoreToMem) import Spar.Sem.ScimUserTimesStore import Spar.Sem.ScimUserTimesStore.Mem (scimUserTimesStoreToMem) @@ -34,25 +34,55 @@ spec = describe "deleteScimUser" $ do it "runs deletion for deleted brig users again" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary - r <- (simulateDeletedBrigUser . toSem) $ deleteScimUser tokenInfo uid + r <- (interpretWithBrigAccessMock mockBrigForDeletedUser . toSem) $ deleteScimUser tokenInfo uid handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) it "returns no error when the account was deleted for the first time" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary - r <- simulateActiveBrigUser tokenInfo AccountDeleted . toSem $ deleteScimUser tokenInfo uid + r <- + interpretWithBrigAccessMock + (mockBrigForActiveUser tokenInfo AccountDeleted) + (deleteUserAndAssertDeletionInSpar uid tokenInfo) handlerResult r `shouldBe` Right () it "returns an error when the account was partitially(!) deleted before" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary - r <- simulateActiveBrigUser tokenInfo AccountAlreadyDeleted . toSem $ deleteScimUser tokenInfo uid + r <- + interpretWithBrigAccessMock + (mockBrigForActiveUser tokenInfo AccountAlreadyDeleted) + (deleteUserAndAssertDeletionInSpar uid tokenInfo) handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) +deleteUserAndAssertDeletionInSpar :: + forall (r :: EffectRow). + Members + '[ Logger (Msg -> Msg), + BrigAccess, + ScimExternalIdStore.ScimExternalIdStore, + ScimUserTimesStore, + SAMLUserStore, + IdPConfigStore, + Embed IO + ] + r => + UserId -> + ScimTokenInfo -> + Sem r (Either ScimError ()) +deleteUserAndAssertDeletionInSpar uid tokenInfo = do + let tid = stiTeam tokenInfo + email = (fromJust . parseEmail) "someone@wire.com" + ScimExternalIdStore.insert tid email uid + r <- toSem $ deleteScimUser tokenInfo uid + lr <- ScimExternalIdStore.lookup tid email + liftIO $ lr `shouldBe` Nothing + pure r + toSem :: forall (r :: EffectRow). Members '[ Logger (Msg -> Msg), BrigAccess, - ScimExternalIdStore, + ScimExternalIdStore.ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPConfigStore @@ -62,17 +92,18 @@ toSem :: Sem r (Either ScimError ()) toSem = runExceptT -type Effs = - '[ BrigAccess, - IdPConfigStore, +type EffsWithoutBrigAccess = + '[ IdPConfigStore, SAMLUserStore, ScimUserTimesStore, - ScimExternalIdStore, + ScimExternalIdStore.ScimExternalIdStore, Logger (Msg -> Msg), Embed IO, Final IO ] +type Effs = BrigAccess ': EffsWithoutBrigAccess + type InterpreterState = ( Map (Data.Id.TeamId, Wire.API.User.Identity.Email) Data.Id.UserId, ( Map Data.Id.UserId (Data.Json.Util.UTCTimeMillis, Data.Json.Util.UTCTimeMillis), @@ -85,10 +116,13 @@ type InterpreterState = handlerResult :: InterpreterState -> Either ScimError () handlerResult = snd . snd . snd . snd -simulateDeletedBrigUser :: +interpretWithBrigAccessMock :: + ( Sem Effs (Either ScimError ()) -> + Sem EffsWithoutBrigAccess (Either ScimError ()) + ) -> Sem Effs (Either ScimError ()) -> IO InterpreterState -simulateDeletedBrigUser = +interpretWithBrigAccessMock mock = runFinal . embedToFinal @IO . discardTinyLogs @@ -96,13 +130,13 @@ simulateDeletedBrigUser = . scimUserTimesStoreToMem . samlUserStoreToMem . idPToMem - . mockBrigForDeletedUser + . mock mockBrigForDeletedUser :: forall (r1 :: EffectRow). Members '[ Logger (Msg -> Msg), - ScimExternalIdStore, + ScimExternalIdStore.ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPConfigStore, @@ -118,26 +152,11 @@ mockBrigForDeletedUser = interpret $ \case liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Make typechecker happy. This won't be reached." -simulateActiveBrigUser :: - ScimTokenInfo -> - DeleteUserResult -> - Sem Effs (Either ScimError ()) -> - IO InterpreterState -simulateActiveBrigUser tokenInfo deletionResult = - runFinal - . embedToFinal @IO - . discardTinyLogs - . scimExternalIdStoreToMem - . scimUserTimesStoreToMem - . samlUserStoreToMem - . idPToMem - . mockBrigForActiveUser tokenInfo deletionResult - mockBrigForActiveUser :: forall (r1 :: EffectRow). Members '[ Logger (Msg -> Msg), - ScimExternalIdStore, + ScimExternalIdStore.ScimExternalIdStore, ScimUserTimesStore, SAMLUserStore, IdPConfigStore, @@ -150,29 +169,31 @@ mockBrigForActiveUser :: Sem r1 (Either ScimError ()) mockBrigForActiveUser tokenInfo deletionResult = interpret $ \case (GetAccount WithPendingInvitations uid) -> do - acc <- liftIO $ someActiveUser uid + acc <- liftIO $ someActiveUser uid tokenInfo pure $ Just acc (Spar.Sem.BrigAccess.DeleteUser _) -> pure deletionResult _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Make typechecker happy. This won't be reached." + +someActiveUser :: UserId -> ScimTokenInfo -> IO UserAccount +someActiveUser uid tokenInfo = do + user <- generate arbitrary + pure $ + UserAccount + { accountStatus = Active, + accountUser = + user + { userDisplayName = Name "default", + userAccentId = defaultAccentId, + userPict = noPict, + userAssets = [], + userHandle = Nothing, + userLocale = defLoc, + userIdentity = (Just . EmailIdentity . fromJust . parseEmail) "someone@wire.com", + userId = uid, + userTeam = Just $ stiTeam tokenInfo + } + } where - someActiveUser uid = do - user <- generate arbitrary - pure $ - UserAccount - { accountStatus = Active, - accountUser = - user - { userDisplayName = Name "default", - userAccentId = defaultAccentId, - userPict = noPict, - userAssets = [], - userHandle = Nothing, - userLocale = defLoc, - userIdentity = Nothing, - userId = uid, - userTeam = Just $ stiTeam tokenInfo - } - } defLoc = fromJust $ parseLocale "De-de" From 101a67d7cf98f82621fb9f49133b71b6c965a085 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 17:02:57 +0200 Subject: [PATCH 34/56] Cleanup --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 30 +++++-------------- 1 file changed, 7 insertions(+), 23 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index ef7ef79550..ba8bb61c65 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -22,7 +22,6 @@ import Spar.Sem.ScimUserTimesStore.Mem (scimUserTimesStoreToMem) import System.Logger (Msg) import Test.Hspec import Test.QuickCheck -import qualified Web.Scim.Handler as Scim import Web.Scim.Schema.Error import Wire.API.User import qualified Wire.API.User.Identity @@ -34,9 +33,9 @@ spec = describe "deleteScimUser" $ do it "runs deletion for deleted brig users again" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary - r <- (interpretWithBrigAccessMock mockBrigForDeletedUser . toSem) $ deleteScimUser tokenInfo uid + r <- (interpretWithBrigAccessMock mockBrigForDeletedUser . runExceptT) $ deleteScimUser tokenInfo uid handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) - it "returns no error when the account was deleted for the first time" $ do + it "returns no error when the account was deleted for the first time or partially" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary r <- @@ -44,7 +43,7 @@ spec = describe "deleteScimUser" $ do (mockBrigForActiveUser tokenInfo AccountDeleted) (deleteUserAndAssertDeletionInSpar uid tokenInfo) handlerResult r `shouldBe` Right () - it "returns an error when the account was partitially(!) deleted before" $ do + it "returns an error when the account was deleted before" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary r <- @@ -72,26 +71,11 @@ deleteUserAndAssertDeletionInSpar uid tokenInfo = do let tid = stiTeam tokenInfo email = (fromJust . parseEmail) "someone@wire.com" ScimExternalIdStore.insert tid email uid - r <- toSem $ deleteScimUser tokenInfo uid + r <- runExceptT $ deleteScimUser tokenInfo uid lr <- ScimExternalIdStore.lookup tid email liftIO $ lr `shouldBe` Nothing pure r -toSem :: - forall (r :: EffectRow). - Members - '[ Logger (Msg -> Msg), - BrigAccess, - ScimExternalIdStore.ScimExternalIdStore, - ScimUserTimesStore, - SAMLUserStore, - IdPConfigStore - ] - r => - Scim.ScimHandler (Sem r) () -> - Sem r (Either ScimError ()) -toSem = runExceptT - type EffsWithoutBrigAccess = '[ IdPConfigStore, SAMLUserStore, @@ -147,10 +131,10 @@ mockBrigForDeletedUser :: Sem r1 (Either ScimError ()) mockBrigForDeletedUser = interpret $ \case (GetAccount WithPendingInvitations _) -> pure Nothing - (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountAlreadyDeleted + (Spar.Sem.BrigAccess.DeleteUser _) -> pure NoUser _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" - error "Make typechecker happy. This won't be reached." + error "Throw error here to avoid implementation of all cases." mockBrigForActiveUser :: forall (r1 :: EffectRow). @@ -174,7 +158,7 @@ mockBrigForActiveUser tokenInfo deletionResult = interpret $ \case (Spar.Sem.BrigAccess.DeleteUser _) -> pure deletionResult _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" - error "Make typechecker happy. This won't be reached." + error "Throw error here to avoid implementation of all cases." someActiveUser :: UserId -> ScimTokenInfo -> IO UserAccount someActiveUser uid tokenInfo = do From 861b48a8efb940a446c2910414c6c54bfc7abd3b Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 17:55:50 +0200 Subject: [PATCH 35/56] Remove dangerous statement --- services/spar/src/Spar/Scim/User.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index ad44feaed2..04d56620a1 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -707,8 +707,9 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = mbBrigUser <- lift $ Brig.getBrigUser WithPendingInvitations uid case mbBrigUser of Nothing -> do - -- Ensure there's no left-over of this user in brig. - _ <- lift $ BrigAccess.deleteUser uid + -- Impossible to check that the user belongs to the token's team + -- (otherwise, a malicious user could delete all users...). Thus, + -- nothing can be done here, except returning an error. throwError $ Scim.notFound "user" (idToText uid) Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM From fa37cfbd292162354091c8a769dc883ccc2cfc0e Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 18:27:19 +0200 Subject: [PATCH 36/56] Adjust test cases --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index ba8bb61c65..7c48f64c54 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -30,12 +30,7 @@ import Wire.Sem.Logger.TinyLog (discardTinyLogs) spec :: Spec spec = describe "deleteScimUser" $ do - it "runs deletion for deleted brig users again" $ do - uid <- generate arbitrary - tokenInfo <- generate arbitrary - r <- (interpretWithBrigAccessMock mockBrigForDeletedUser . runExceptT) $ deleteScimUser tokenInfo uid - handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) - it "returns no error when the account was deleted for the first time or partially" $ do + it "returns no error when the account was deleted for the first time (or partially)" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary r <- @@ -51,6 +46,14 @@ spec = describe "deleteScimUser" $ do (mockBrigForActiveUser tokenInfo AccountAlreadyDeleted) (deleteUserAndAssertDeletionInSpar uid tokenInfo) handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) + it "returns an error when there never was an account" $ do + uid <- generate arbitrary + tokenInfo <- generate arbitrary + r <- + interpretWithBrigAccessMock + mockBrigForNonExistendUser + (runExceptT $ deleteScimUser tokenInfo uid) + handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) deleteUserAndAssertDeletionInSpar :: forall (r :: EffectRow). @@ -116,7 +119,7 @@ interpretWithBrigAccessMock mock = . idPToMem . mock -mockBrigForDeletedUser :: +mockBrigForNonExistendUser :: forall (r1 :: EffectRow). Members '[ Logger (Msg -> Msg), @@ -129,7 +132,7 @@ mockBrigForDeletedUser :: r1 => Sem (BrigAccess ': r1) (Either ScimError ()) -> Sem r1 (Either ScimError ()) -mockBrigForDeletedUser = interpret $ \case +mockBrigForNonExistendUser = interpret $ \case (GetAccount WithPendingInvitations _) -> pure Nothing (Spar.Sem.BrigAccess.DeleteUser _) -> pure NoUser _ -> do From 69eff352958db5a6598686887402ec04bc7be7e8 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 18:49:32 +0200 Subject: [PATCH 37/56] Make test data consistent --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 61 +++++++++---------- 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 7c48f64c54..fb17b458f2 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -4,6 +4,7 @@ import Arbitrary () import Brig.Types.Intra import Brig.Types.User import Control.Monad.Except (runExceptT) +import Data.Handle (parseHandle) import Data.Id import qualified Data.Json.Util import Imports @@ -31,21 +32,21 @@ import Wire.Sem.Logger.TinyLog (discardTinyLogs) spec :: Spec spec = describe "deleteScimUser" $ do it "returns no error when the account was deleted for the first time (or partially)" $ do - uid <- generate arbitrary tokenInfo <- generate arbitrary + acc <- someActiveUser tokenInfo r <- interpretWithBrigAccessMock - (mockBrigForActiveUser tokenInfo AccountDeleted) - (deleteUserAndAssertDeletionInSpar uid tokenInfo) + (mockBrigForActiveUser acc AccountDeleted) + (deleteUserAndAssertDeletionInSpar acc tokenInfo) handlerResult r `shouldBe` Right () it "returns an error when the account was deleted before" $ do - uid <- generate arbitrary tokenInfo <- generate arbitrary + acc <- someActiveUser tokenInfo r <- interpretWithBrigAccessMock - (mockBrigForActiveUser tokenInfo AccountAlreadyDeleted) - (deleteUserAndAssertDeletionInSpar uid tokenInfo) - handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) + (mockBrigForActiveUser acc AccountAlreadyDeleted) + (deleteUserAndAssertDeletionInSpar acc tokenInfo) + handlerResult r `shouldBe` Left (notFound "user" ((idToText . userId . accountUser) acc)) it "returns an error when there never was an account" $ do uid <- generate arbitrary tokenInfo <- generate arbitrary @@ -67,12 +68,13 @@ deleteUserAndAssertDeletionInSpar :: Embed IO ] r => - UserId -> + UserAccount -> ScimTokenInfo -> Sem r (Either ScimError ()) -deleteUserAndAssertDeletionInSpar uid tokenInfo = do +deleteUserAndAssertDeletionInSpar acc tokenInfo = do let tid = stiTeam tokenInfo - email = (fromJust . parseEmail) "someone@wire.com" + email = (fromJust . emailIdentity . fromJust . userIdentity . accountUser) acc + uid = (userId . accountUser) acc ScimExternalIdStore.insert tid email uid r <- runExceptT $ deleteScimUser tokenInfo uid lr <- ScimExternalIdStore.lookup tid email @@ -120,7 +122,7 @@ interpretWithBrigAccessMock mock = . mock mockBrigForNonExistendUser :: - forall (r1 :: EffectRow). + forall (r :: EffectRow). Members '[ Logger (Msg -> Msg), ScimExternalIdStore.ScimExternalIdStore, @@ -129,9 +131,9 @@ mockBrigForNonExistendUser :: IdPConfigStore, Embed IO ] - r1 => - Sem (BrigAccess ': r1) (Either ScimError ()) -> - Sem r1 (Either ScimError ()) + r => + Sem (BrigAccess ': r) (Either ScimError ()) -> + Sem r (Either ScimError ()) mockBrigForNonExistendUser = interpret $ \case (GetAccount WithPendingInvitations _) -> pure Nothing (Spar.Sem.BrigAccess.DeleteUser _) -> pure NoUser @@ -140,7 +142,7 @@ mockBrigForNonExistendUser = interpret $ \case error "Throw error here to avoid implementation of all cases." mockBrigForActiveUser :: - forall (r1 :: EffectRow). + forall (r :: EffectRow). Members '[ Logger (Msg -> Msg), ScimExternalIdStore.ScimExternalIdStore, @@ -149,38 +151,35 @@ mockBrigForActiveUser :: IdPConfigStore, Embed IO ] - r1 => - ScimTokenInfo -> + r => + UserAccount -> DeleteUserResult -> - Sem (BrigAccess ': r1) (Either ScimError ()) -> - Sem r1 (Either ScimError ()) -mockBrigForActiveUser tokenInfo deletionResult = interpret $ \case - (GetAccount WithPendingInvitations uid) -> do - acc <- liftIO $ someActiveUser uid tokenInfo - pure $ Just acc + Sem (BrigAccess ': r) (Either ScimError ()) -> + Sem r (Either ScimError ()) +mockBrigForActiveUser acc deletionResult = interpret $ \case + (GetAccount WithPendingInvitations uid) -> + if uid == (userId . accountUser) acc + then pure $ Just acc + else pure Nothing (Spar.Sem.BrigAccess.DeleteUser _) -> pure deletionResult _ -> do liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Throw error here to avoid implementation of all cases." -someActiveUser :: UserId -> ScimTokenInfo -> IO UserAccount -someActiveUser uid tokenInfo = do +someActiveUser :: ScimTokenInfo -> IO UserAccount +someActiveUser tokenInfo = do user <- generate arbitrary pure $ UserAccount { accountStatus = Active, accountUser = user - { userDisplayName = Name "default", + { userDisplayName = Name "Some User", userAccentId = defaultAccentId, userPict = noPict, userAssets = [], - userHandle = Nothing, - userLocale = defLoc, + userHandle = parseHandle "some-handle", userIdentity = (Just . EmailIdentity . fromJust . parseEmail) "someone@wire.com", - userId = uid, userTeam = Just $ stiTeam tokenInfo } } - where - defLoc = fromJust $ parseLocale "De-de" From 0bd6878f8cbe02c158172d52ee033fff1d9d6445 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 5 Sep 2022 18:52:50 +0200 Subject: [PATCH 38/56] Cleanup effects --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 20 ++----------------- 1 file changed, 2 insertions(+), 18 deletions(-) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index fb17b458f2..4f1f0336f8 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -123,15 +123,7 @@ interpretWithBrigAccessMock mock = mockBrigForNonExistendUser :: forall (r :: EffectRow). - Members - '[ Logger (Msg -> Msg), - ScimExternalIdStore.ScimExternalIdStore, - ScimUserTimesStore, - SAMLUserStore, - IdPConfigStore, - Embed IO - ] - r => + Members '[Embed IO] r => Sem (BrigAccess ': r) (Either ScimError ()) -> Sem r (Either ScimError ()) mockBrigForNonExistendUser = interpret $ \case @@ -143,15 +135,7 @@ mockBrigForNonExistendUser = interpret $ \case mockBrigForActiveUser :: forall (r :: EffectRow). - Members - '[ Logger (Msg -> Msg), - ScimExternalIdStore.ScimExternalIdStore, - ScimUserTimesStore, - SAMLUserStore, - IdPConfigStore, - Embed IO - ] - r => + Members '[Embed IO] r => UserAccount -> DeleteUserResult -> Sem (BrigAccess ': r) (Either ScimError ()) -> From aa5437a7378766b74a869c5b145b945403b64ea0 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 07:03:47 +0200 Subject: [PATCH 39/56] Rename: deleteUserNoVerifyH -> deleteUserNoAuthH --- services/brig/src/Brig/API/Internal.hs | 6 +++--- services/galley/src/Galley/Intra/User.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 6c87100f1b..8850e8f574 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -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,8 +508,8 @@ createUserNoVerifySpar uData = in API.activate key code (Just uid) !>> CreateUserSparRegistrationError . activationErrorToRegisterError pure . SelfProfile $ usr -deleteUserNoVerifyH :: UserId -> (Handler r) Response -deleteUserNoVerifyH uid = do +deleteUserNoAuthH :: UserId -> (Handler r) Response +deleteUserNoAuthH uid = do r <- lift $ wrapHttp $ API.ensureAccountDeleted uid pure $ case r of NoUser -> setStatus status404 $ json r diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index 0a5ed99992..90b24af2e5 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -205,7 +205,7 @@ getUsers = chunkify $ \uids -> do . expect2xx pure . fromMaybe [] . responseJsonMaybe $ resp --- | Calls 'Brig.API.deleteUserNoVerifyH'. +-- | Calls 'Brig.API.deleteUserNoAuthH'. deleteUser :: UserId -> App () deleteUser uid = do void $ From 27869ca013c0b15a234ef9b345683e03327adb27 Mon Sep 17 00:00:00 2001 From: Matthias Fischmann Date: Tue, 6 Sep 2022 10:27:50 +0200 Subject: [PATCH 40/56] hlint --- services/galley/src/Galley/API/MLS/Message.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index fc6edcfcf0..2ace16c5d3 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -534,8 +534,7 @@ applyProposal convId (AddProposal kp) = do Nothing -> do -- external add proposal for a new key package unknown to the backend lconvId <- qualifyLocal convId - ci <- addKeyPackageMapping lconvId ref (KeyPackageData (rmRaw kp)) - pure ci + addKeyPackageMapping lconvId ref (KeyPackageData (rmRaw kp)) Just ci -> -- ad-hoc add proposal in commit, the key package has been claimed before pure ci From dc2c41b255de8d16860afd810a3cef001c4c71ac Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 10:23:05 +0200 Subject: [PATCH 41/56] Revert: Remove dangerous statement (e2a6cb7f8c66c6d2de80dc53ce2cc792d30e9b05) --- services/spar/src/Spar/Scim/User.hs | 35 ++++++++++++++++------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 04d56620a1..3d1f2d3c61 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -705,12 +705,15 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- Nothing`) to delete a user in spar. I.e. `SAML.UserRef` and `Email` -- cannot be figured out when a `User` has status `Deleted`. mbBrigUser <- lift $ Brig.getBrigUser WithPendingInvitations uid - case mbBrigUser of - Nothing -> do - -- Impossible to check that the user belongs to the token's team - -- (otherwise, a malicious user could delete all users...). Thus, - -- nothing can be done here, except returning an error. - throwError $ Scim.notFound "user" (idToText uid) + deletionStatus <- case mbBrigUser of + Nothing -> + -- Ensure there's no left-over of this user in brig. This is safe + -- because the user has either been deleted (tombstone) or does not + -- exist. Asserting the correct team id here is not needed (and would + -- be hard as the check relies on the data of `mbBrigUser`): The worst + -- thing that could happen is that foreign users cleanup particially + -- deleted users. + lift $ BrigAccess.deleteUser uid Just brigUser -> do -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM -- (because that owner won't be managed by SCIM in the first place), but if it ever becomes @@ -725,16 +728,16 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- dependency prevents us from cleaning up users with deleted accounts -- in brig here in spar. deleteUserInSpar brigUser - deletionStatus <- lift $ BrigAccess.deleteUser uid - case deletionStatus of - NoUser -> - throwError $ - Scim.notFound "user" (idToText uid) - AccountAlreadyDeleted -> - throwError $ - Scim.notFound "user" (idToText uid) - AccountDeleted -> - pure () + lift $ BrigAccess.deleteUser uid + case deletionStatus of + NoUser -> + throwError $ + Scim.notFound "user" (idToText uid) + AccountAlreadyDeleted -> + throwError $ + Scim.notFound "user" (idToText uid) + AccountDeleted -> + pure () where deleteUserInSpar :: Members From 199276abe48920fb953f74364f3edd3c79b4b7b2 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 11:43:58 +0200 Subject: [PATCH 42/56] Add punctuation to Haddock Co-authored-by: fisx --- services/brig/src/Brig/API/User.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 2e468414bf..681a6aa435 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1232,7 +1232,7 @@ verifyDeleteUser d = do for_ account $ lift . wrapHttpClient . deleteAccount lift . wrapClient $ Code.delete key Code.AccountDeletion --- | Check if `deleteAccount` succeeded and run it again if needed +-- | Check if `deleteAccount` succeeded and run it again if needed. -- Called via @delete /i/user/:uid@. ensureAccountDeleted :: ( MonadLogger m, From 5d33d736a184d6dadf45157e44e62934f659c120 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 11:45:57 +0200 Subject: [PATCH 43/56] Ensure boundaries with type parameter Co-authored-by: fisx --- services/brig/src/Brig/API/User.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 681a6aa435..ed5dede584 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1261,7 +1261,7 @@ ensureAccountDeleted uid = do clients <- Data.lookupClients uid localUid <- qualifyLocal uid - conCount <- countConnections localUid [minBound .. maxBound] + conCount <- countConnections localUid [(minBound @Relation) .. maxBound] cookies <- listCookies uid [] if (not . null) probs From 954426008868ce24043fd8406a85e5c31af6da0b Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 11:48:44 +0200 Subject: [PATCH 44/56] Typo Co-authored-by: fisx --- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 98cf588904..3d12a67694 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -55,7 +55,7 @@ brigAccessToHttp mgr req = SetLocale itlu l -> Intra.setBrigUserLocale itlu l GetRichInfo itlu -> Intra.getBrigUserRichInfo itlu CheckHandleAvailable h -> Intra.checkHandleAvailable h - DeleteUser itlu -> Itra.deleteBrigUserInternal itlu + DeleteUser itlu -> Intra.deleteBrigUserInternal itlu EnsureReAuthorised mitlu mp mc ma -> Intra.ensureReAuthorised mitlu mp mc ma SsoLogin itlu -> Intra.ssoLogin itlu GetStatus itlu -> Intra.getStatus itlu From 5f38d6a2ca25cfce53588abca75746221afcf880 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 11:48:57 +0200 Subject: [PATCH 45/56] Typo Co-authored-by: fisx --- services/spar/src/Spar/Sem/BrigAccess/Http.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 3d12a67694..cbcafe8ad3 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -26,7 +26,6 @@ import Polysemy import Polysemy.Error (Error) import Spar.Error (SparError) import qualified Spar.Intra.Brig as Intra -import qualified Spar.Intra.Brig as Itra import Spar.Sem.BrigAccess import Spar.Sem.Utils (RunHttpEnv (..), viaRunHttp) import qualified System.Logger as TinyLog From 8c1778e26faf310b0e576cd84d3c6c42166646c0 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 11:54:31 +0200 Subject: [PATCH 46/56] Use simpler function Co-authored-by: fisx --- services/brig/src/Brig/API/User.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index ed5dede584..50d00ef76a 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -1264,7 +1264,7 @@ ensureAccountDeleted uid = do conCount <- countConnections localUid [(minBound @Relation) .. maxBound] cookies <- listCookies uid [] - if (not . null) probs + if notNull probs || not accIsDeleted || (not . null) clients || conCount > 0 From c3948a4ba1e4d0e96587b9852cbb0d6d01933503 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 12:05:20 +0200 Subject: [PATCH 47/56] Add comment Co-authored-by: fisx --- services/brig/src/Brig/User/Handle.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/src/Brig/User/Handle.hs b/services/brig/src/Brig/User/Handle.hs index c91c8d4a95..c0be08f29c 100644 --- a/services/brig/src/Brig/User/Handle.hs +++ b/services/brig/src/Brig/User/Handle.hs @@ -65,7 +65,7 @@ freeHandle uid h = do retry x5 $ write handleDelete (params LocalQuorum (Identity h)) let key = "@" <> fromHandle h deleteClaim uid key (30 # Minute) - _ -> pure () + _ -> 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) From ed4f0acd60c0351b2b0c177f485c6a9d035a165f Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 12:06:29 +0200 Subject: [PATCH 48/56] Improve comment Co-authored-by: fisx --- services/spar/src/Spar/Scim/User.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 3d1f2d3c61..3203877cd0 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -700,7 +700,7 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = ) (const id) $ do - -- `getBrigUser` does not include deleted users. However, these + -- `getBrigUser` does not include deleted users. This is fine: these -- ("tombstones") would not have the needed values (`userIdentity = -- Nothing`) to delete a user in spar. I.e. `SAML.UserRef` and `Email` -- cannot be figured out when a `User` has status `Deleted`. From 9dc3f65e5a81ba3dec6b1d269d369c06b87bb3f4 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 6 Sep 2022 13:44:10 +0200 Subject: [PATCH 49/56] Better comment Co-authored-by: fisx --- services/spar/src/Spar/Scim/User.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 3203877cd0..4b9c97b7ac 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -725,8 +725,10 @@ deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = -- This deletion needs data from the non-deleted User in brig. So, -- execute it first, then delete the user in brig. Unfortunately, this - -- dependency prevents us from cleaning up users with deleted accounts - -- in brig here in spar. + -- dependency prevents us from cleaning up the spar fragments of users + -- that have been deleted in brig. Deleting scim-managed users in brig + -- (via the TM app) is blocked, though, so there is no legal way to enter + -- that situation. deleteUserInSpar brigUser lift $ BrigAccess.deleteUser uid case deletionStatus of From 1a14b0c853a48eaf0e45b26b8c3c2e4f3fef5b53 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Sep 2022 08:01:08 +0200 Subject: [PATCH 50/56] Add Haddock --- services/brig/src/Brig/Data/UserKey.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/services/brig/src/Brig/Data/UserKey.hs b/services/brig/src/Brig/Data/UserKey.hs index 980b0b68bf..28c4212435 100644 --- a/services/brig/src/Brig/Data/UserKey.hs +++ b/services/brig/src/Brig/Data/UserKey.hs @@ -165,6 +165,14 @@ 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 From 420d80ae3dbefce3d8ef54ec0224e832eb381964 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Sep 2022 08:35:20 +0200 Subject: [PATCH 51/56] Use function instead of `not.null` --- services/brig/brig.cabal | 1 + services/brig/src/Brig/API/User.hs | 5 +++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index 353fb359f7..392f90d30e 100644 --- a/services/brig/brig.cabal +++ b/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 diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index 50d00ef76a..a555bae570 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -149,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 @@ -1266,9 +1267,9 @@ ensureAccountDeleted uid = do if notNull probs || not accIsDeleted - || (not . null) clients + || notNull clients || conCount > 0 - || (not . null) cookies + || notNull cookies then do deleteAccount acc pure AccountDeleted From 0d313d5b27b5615ae9c529c46afdc94a49897d76 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Sep 2022 09:14:03 +0200 Subject: [PATCH 52/56] Rely on status codes as result of internal user deletion --- libs/wire-api/src/Wire/API/User.hs | 32 +++++-------------- services/brig/src/Brig/API/Internal.hs | 8 ++--- .../brig/test/integration/API/User/Account.hs | 4 --- services/spar/src/Spar/Intra/Brig.hs | 4 ++- 4 files changed, 15 insertions(+), 33 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 55ba8f3499..e61446113f 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -121,7 +121,6 @@ import Control.Applicative import Control.Error.Safe (rightMay) import Control.Lens (over, view, (.~), (?~), (^.)) import Data.Aeson (FromJSON (..), ToJSON (..)) -import Data.Aeson.Types (parseFail) import qualified Data.Aeson.Types as A import qualified Data.Attoparsec.ByteString as Parser import Data.ByteString.Builder (toLazyByteString) @@ -1358,31 +1357,16 @@ instance FromJSON DeletionCodeTimeout where parseJSON = A.withObject "DeletionCodeTimeout" $ \o -> DeletionCodeTimeout <$> o A..: "expires_in" -data DeleteUserResult = NoUser | AccountAlreadyDeleted | AccountDeleted +-- | 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) -instance ToJSON DeleteUserResult where - toJSON t = A.object ["tag" A..= toTag t] - where - toTag :: DeleteUserResult -> A.Value - toTag NoUser = "no-user" - toTag AccountAlreadyDeleted = "already-deleted" - toTag AccountDeleted = "deleted" - -instance FromJSON DeleteUserResult where - parseJSON (A.Object o) = do - tagString <- o A..: "tag" - case fromTag tagString of - Just t -> pure t - Nothing -> A.parseFail $ "Unknown tag: " ++ tagString - where - fromTag :: String -> Maybe DeleteUserResult - fromTag "no-user" = Just NoUser - fromTag "already-deleted" = Just AccountAlreadyDeleted - fromTag "deleted" = Just AccountDeleted - fromTag _ = Nothing - parseJSON _ = parseFail "Invalid DeleteUserResult" - data ListUsersQuery = ListUsersByIds [Qualified UserId] | ListUsersByHandles (Range 1 4 [Qualified Handle]) diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 8850e8f574..3f3e0a6718 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -511,10 +511,10 @@ createUserNoVerifySpar uData = deleteUserNoAuthH :: UserId -> (Handler r) Response deleteUserNoAuthH uid = do r <- lift $ wrapHttp $ API.ensureAccountDeleted uid - pure $ case r of - NoUser -> setStatus status404 $ json r - AccountAlreadyDeleted -> setStatus status200 $ json r - AccountDeleted -> setStatus status202 $ json r + case r of + NoUser -> throwStd (errorToWai @'E.UserNotFound) + AccountAlreadyDeleted -> pure $ setStatus status200 empty + AccountDeleted -> pure $ setStatus status202 empty changeSelfEmailMaybeSendH :: Member BlacklistStore r => UserId ::: Bool ::: JsonRequest EmailUpdate -> (Handler r) Response changeSelfEmailMaybeSendH (u ::: validate ::: req) = do diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs index 13a242f23e..07a4ef632c 100644 --- a/services/brig/test/integration/API/User/Account.hs +++ b/services/brig/test/integration/API/User/Account.hs @@ -1644,7 +1644,6 @@ testDeleteUserWithCompletelyDeletedUser brig cannon aws = do deleteUserInternal uid brig !!! do const 200 === statusCode - const (Right AccountAlreadyDeleted) === responseJsonEither testDeleteUserWithNoUser :: Brig -> Http () testDeleteUserWithNoUser brig = do @@ -1652,7 +1651,6 @@ testDeleteUserWithNoUser brig = do deleteUserInternal nonExistingUid brig !!! do const 404 === statusCode - const (Right NoUser) === responseJsonEither testDeleteUserWithNotDeletedUser :: HasCallStack => Brig -> Cannon -> AWS.Env -> Http () testDeleteUserWithNotDeletedUser brig cannon aws = do @@ -1664,7 +1662,6 @@ testDeleteUserWithNotDeletedUser brig cannon aws = do deleteUserInternal uid' brig !!! do const 202 === statusCode - const (Right AccountDeleted) === responseJsonEither ) testDeleteUserWithDanglingProperty :: Brig -> Cannon -> AWS.Env -> Http () @@ -1692,7 +1689,6 @@ testDeleteUserWithDanglingProperty brig cannon aws = do deleteUserInternal uid' brig !!! do const 202 === statusCode - const (Right AccountDeleted) === responseJsonEither getProperty brig (userId u) "foo" !!! do const 404 === statusCode diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index b5bc4099fc..2a2f088ef7 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -338,7 +338,9 @@ deleteBrigUserInternal buid = do method DELETE . paths ["/i/users", toByteString' buid] case statusCode resp of - i | i == 200 || i == 202 || i == 404 -> parseResponse "brig" resp + 200 -> pure AccountAlreadyDeleted + 202 -> pure AccountDeleted + 404 -> pure NoUser _ -> rethrow "brig" resp -- | Verify user's password (needed for certain powerful operations). From e0977ac700cf85ce443c265de4b6ad8d51364386 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Sep 2022 09:18:01 +0200 Subject: [PATCH 53/56] More readable status codes --- services/brig/src/Brig/API/Internal.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 3f3e0a6718..205f232593 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -513,8 +513,8 @@ deleteUserNoAuthH uid = do r <- lift $ wrapHttp $ API.ensureAccountDeleted uid case r of NoUser -> throwStd (errorToWai @'E.UserNotFound) - AccountAlreadyDeleted -> pure $ setStatus status200 empty - AccountDeleted -> pure $ setStatus status202 empty + 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 From 5ea53bff9a7800254e6b43235394171b050602a8 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Sep 2022 09:33:51 +0200 Subject: [PATCH 54/56] Formatting --- services/brig/src/Brig/User/Handle.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/services/brig/src/Brig/User/Handle.hs b/services/brig/src/Brig/User/Handle.hs index c0be08f29c..256337cc9e 100644 --- a/services/brig/src/Brig/User/Handle.hs +++ b/services/brig/src/Brig/User/Handle.hs @@ -65,7 +65,7 @@ freeHandle uid h = 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. + _ -> 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) From 25d7236b905d8493aaf1a3c7b4806ee23fcc0bc8 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Sep 2022 10:18:28 +0200 Subject: [PATCH 55/56] Add missing test --- services/spar/test/Test/Spar/Scim/UserSpec.hs | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/services/spar/test/Test/Spar/Scim/UserSpec.hs b/services/spar/test/Test/Spar/Scim/UserSpec.hs index 4f1f0336f8..93918199e5 100644 --- a/services/spar/test/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test/Test/Spar/Scim/UserSpec.hs @@ -55,6 +55,14 @@ spec = describe "deleteScimUser" $ do mockBrigForNonExistendUser (runExceptT $ deleteScimUser tokenInfo uid) handlerResult r `shouldBe` Left (notFound "user" (idToText uid)) + it "returns no error when there was a partially deleted account" $ do + uid <- generate arbitrary + tokenInfo <- generate arbitrary + r <- + interpretWithBrigAccessMock + mockBrigForPartiallyDeletedUser + (runExceptT $ deleteScimUser tokenInfo uid) + handlerResult r `shouldBe` Right () deleteUserAndAssertDeletionInSpar :: forall (r :: EffectRow). @@ -133,6 +141,18 @@ mockBrigForNonExistendUser = interpret $ \case liftIO $ expectationFailure $ "Unexpected effect (call to brig)" error "Throw error here to avoid implementation of all cases." +mockBrigForPartiallyDeletedUser :: + forall (r :: EffectRow). + Members '[Embed IO] r => + Sem (BrigAccess ': r) (Either ScimError ()) -> + Sem r (Either ScimError ()) +mockBrigForPartiallyDeletedUser = interpret $ \case + (GetAccount WithPendingInvitations _) -> pure Nothing + (Spar.Sem.BrigAccess.DeleteUser _) -> pure AccountDeleted + _ -> do + liftIO $ expectationFailure $ "Unexpected effect (call to brig)" + error "Throw error here to avoid implementation of all cases." + mockBrigForActiveUser :: forall (r :: EffectRow). Members '[Embed IO] r => From 23984f59ae089214b0f88901bf56452d0afd0a51 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 7 Sep 2022 16:40:29 +0200 Subject: [PATCH 56/56] Formatting --- services/brig/src/Brig/API/Internal.hs | 6 +++--- services/brig/src/Brig/API/Public.hs | 6 +++--- services/brig/src/Brig/API/User.hs | 12 ++++++------ services/brig/src/Brig/Data/Activation.hs | 2 +- services/brig/src/Brig/Run.hs | 4 ++-- services/brig/src/Brig/Team/API.hs | 2 +- services/brig/test/integration/API/User/Util.hs | 2 +- 7 files changed, 17 insertions(+), 17 deletions(-) diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 205f232593..4a548f766d 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/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 diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 1e44ef1bd0..e6159d3468 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/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) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index a555bae570..ce19c9bdde 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -112,18 +112,18 @@ 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 diff --git a/services/brig/src/Brig/Data/Activation.hs b/services/brig/src/Brig/Data/Activation.hs index a360a4c8d1..3de71d3982 100644 --- a/services/brig/src/Brig/Data/Activation.hs +++ b/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 diff --git a/services/brig/src/Brig/Run.hs b/services/brig/src/Brig/Run.hs index 732f3a03c3..d4813c5dc4 100644 --- a/services/brig/src/Brig/Run.hs +++ b/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 diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 373c4087af..74bda2dead 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/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) diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index a2573fc269..b54f1c3025 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -22,9 +22,9 @@ module API.User.Util where import Bilge hiding (accept, timeout) import Bilge.Assert import qualified Brig.Code as Code -import Brig.Options (Opts) import Brig.Effects.CodeStore import Brig.Effects.CodeStore.Cassandra +import Brig.Options (Opts) import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import qualified Brig.ZAuth import qualified Cassandra as DB