diff --git a/cassandra-schema.cql b/cassandra-schema.cql index efcf3424035..a35870fedfd 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -2165,6 +2165,7 @@ CREATE TABLE spar_test.scim_user_times ( CREATE TABLE spar_test.scim_external ( team uuid, external_id text, + creation_status int, user uuid, PRIMARY KEY (team, external_id) ) WITH CLUSTERING ORDER BY (external_id ASC) diff --git a/changelog.d/3-bug-fixes/WPB-6577 b/changelog.d/3-bug-fixes/WPB-6577 new file mode 100644 index 00000000000..c637c5de29f --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-6577 @@ -0,0 +1 @@ +Prevent conflict on subsequent tries to provision a SCIM user diff --git a/integration/integration.cabal b/integration/integration.cabal index fdbcd8a5230..5ffb61552cb 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -136,6 +136,7 @@ library Test.Roles Test.Search Test.Services + Test.Spar Test.Swagger Test.TeamSettings Test.User diff --git a/integration/test/API/Common.hs b/integration/test/API/Common.hs index 42e33973294..623a2c56579 100644 --- a/integration/test/API/Common.hs +++ b/integration/test/API/Common.hs @@ -31,8 +31,11 @@ randomName = liftIO $ do pick = (chars !) <$> randomRIO (Array.bounds chars) randomHandle :: App String -randomHandle = liftIO $ do - n <- randomRIO (50, 256) +randomHandle = randomHandleWithRange 50 256 + +randomHandleWithRange :: Int -> Int -> App String +randomHandleWithRange min' max' = liftIO $ do + n <- randomRIO (min', max') replicateM n pick where chars = mkArray $ ['a' .. 'z'] <> ['0' .. '9'] <> "_-." diff --git a/integration/test/API/Spar.hs b/integration/test/API/Spar.hs index aff62ca6d5a..e8d1e7cc2f3 100644 --- a/integration/test/API/Spar.hs +++ b/integration/test/API/Spar.hs @@ -1,5 +1,6 @@ module API.Spar where +import API.Common (defPassword) import GHC.Stack import Testlib.Prelude @@ -8,3 +9,15 @@ getScimTokens :: (HasCallStack, MakesValue caller) => caller -> App Response getScimTokens caller = do req <- baseRequest caller Spar Versioned "/scim/auth-tokens" submit "GET" req + +-- https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_scim_auth_tokens +createScimToken :: (HasCallStack, MakesValue caller) => caller -> App Response +createScimToken caller = do + req <- baseRequest caller Spar Versioned "/scim/auth-tokens" + submit "POST" $ req & addJSONObject ["password" .= defPassword, "description" .= "integration test"] + +createScimUser :: (HasCallStack, MakesValue domain, MakesValue scimUser) => domain -> String -> scimUser -> App Response +createScimUser domain token scimUser = do + req <- baseRequest domain Spar Versioned "/scim/v2/Users" + body <- make scimUser + submit "POST" $ req & addJSON body . addHeader "Authorization" ("Bearer " <> token) diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 7a9eab93257..0c263d969e3 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -314,3 +314,15 @@ lhDeviceIdOf bob = do >>= assertOne >>= (%. "id") >>= asString + +randomScimUser :: App Value +randomScimUser = do + email <- randomEmail + handle <- randomHandleWithRange 12 128 + pure $ + object + [ "schemas" .= ["urn:ietf:params:scim:schemas:core:2.0:User"], + "externalId" .= email, + "userName" .= handle, + "displayName" .= handle + ] diff --git a/integration/test/Test/Spar.hs b/integration/test/Test/Spar.hs new file mode 100644 index 00000000000..d1e14e85984 --- /dev/null +++ b/integration/test/Test/Spar.hs @@ -0,0 +1,28 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + +module Test.Spar where + +import API.Spar +import Control.Concurrent (threadDelay) +import SetupHelpers +import Testlib.Prelude + +testSparUserCreationInvitationTimeout :: HasCallStack => App () +testSparUserCreationInvitationTimeout = do + (owner, _tid, _) <- createTeam OwnDomain 1 + tok <- createScimToken owner >>= \resp -> resp.json %. "token" >>= asString + scimUser <- randomScimUser + bindResponse (createScimUser OwnDomain tok scimUser) $ \res -> do + res.status `shouldMatchInt` 201 + + -- Trying to create the same user again right away should fail + bindResponse (createScimUser OwnDomain tok scimUser) $ \res -> do + res.status `shouldMatchInt` 409 + + -- However, if we wait until the invitation timeout has passed + -- (assuming it is configured to 10s locally and in CI)... + liftIO $ threadDelay (11_000_000) + + -- ...we should be able to create the user again + retryT $ bindResponse (createScimUser OwnDomain tok scimUser) $ \res -> do + res.status `shouldMatchInt` 201 diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index c0095855963..d7f9da9ae09 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -59,6 +59,7 @@ module Wire.API.User CreateUserSparInternalResponses, newUserFromSpar, urefToExternalId, + urefToExternalIdUnsafe, urefToEmail, ExpiresIn, newUserInvitationCode, @@ -958,6 +959,9 @@ urefToEmail uref = case uref ^. SAML.uidSubject . SAML.nameID of SAML.UNameIDEmail email -> parseEmail . SAMLEmail.render . CI.original $ email _ -> Nothing +urefToExternalIdUnsafe :: SAML.UserRef -> Text +urefToExternalIdUnsafe = CI.original . SAML.unsafeShowNameID . view SAML.uidSubject + data CreateUserSparError = CreateUserSparHandleError ChangeHandleError | CreateUserSparRegistrationError RegisterError @@ -1904,6 +1908,7 @@ instance Schema.ToSchema UserAccount where data NewUserScimInvitation = NewUserScimInvitation -- FIXME: the TID should be captured in the route as usual { newUserScimInvTeamId :: TeamId, + newUserScimInvUserId :: UserId, newUserScimInvLocale :: Maybe Locale, newUserScimInvName :: Name, newUserScimInvEmail :: Email, @@ -1918,6 +1923,7 @@ instance Schema.ToSchema NewUserScimInvitation where Schema.object "NewUserScimInvitation" $ NewUserScimInvitation <$> newUserScimInvTeamId Schema..= Schema.field "team_id" Schema.schema + <*> newUserScimInvUserId Schema..= Schema.field "user_id" Schema.schema <*> newUserScimInvLocale Schema..= maybe_ (optField "locale" Schema.schema) <*> newUserScimInvName Schema..= Schema.field "name" Schema.schema <*> newUserScimInvEmail Schema..= Schema.field "email" Schema.schema diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index 752c608bd85..991acf717f5 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -42,7 +42,7 @@ -- * Request and response types for SCIM-related endpoints. module Wire.API.User.Scim where -import Control.Lens (Prism', makeLenses, mapped, prism', (.~), (?~)) +import Control.Lens (Prism', makeLenses, mapped, prism', (.~), (?~), (^.)) import Control.Monad.Except (throwError) import Crypto.Hash (hash) import Crypto.Hash.Algorithms (SHA512) @@ -83,7 +83,8 @@ import Web.Scim.Schema.Schema qualified as Scim import Web.Scim.Schema.User qualified as Scim import Web.Scim.Schema.User qualified as Scim.User import Wire.API.Team.Role (Role) -import Wire.API.User.Identity (Email) +import Wire.API.User (emailFromSAMLNameID, urefToExternalIdUnsafe) +import Wire.API.User.Identity (Email, fromEmail) import Wire.API.User.Profile as BT import Wire.API.User.RichInfo qualified as RI import Wire.API.User.Saml () @@ -338,6 +339,15 @@ data ValidExternalId | EmailOnly Email deriving (Eq, Show, Generic) +instance Arbitrary ValidExternalId where + arbitrary = do + muref <- QC.arbitrary + case muref of + Just uref -> case emailFromSAMLNameID $ uref ^. SAML.uidSubject of + Just e -> pure $ EmailAndUref e uref + Nothing -> pure $ UrefOnly uref + Nothing -> EmailOnly <$> QC.arbitrary + -- | Take apart a 'ValidExternalId', using 'SAML.UserRef' if available, otherwise 'Email'. runValidExternalIdEither :: (SAML.UserRef -> a) -> (Email -> a) -> ValidExternalId -> a runValidExternalIdEither doUref doEmail = \case @@ -353,6 +363,11 @@ runValidExternalIdBoth merge doUref doEmail = \case UrefOnly uref -> doUref uref EmailOnly em -> doEmail em +-- | Returns either the extracted `UnqualifiedNameID` if present and not qualified, or the email address. +-- This throws an exception if there are any qualifiers. +runValidExternalIdUnsafe :: ValidExternalId -> Text +runValidExternalIdUnsafe = runValidExternalIdEither urefToExternalIdUnsafe fromEmail + veidUref :: Prism' ValidExternalId SAML.UserRef veidUref = prism' UrefOnly $ \case diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index d3d7e096ef2..8b70410265d 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -557,10 +557,9 @@ createUserInviteViaScim :: Member (UserPendingActivationStore p) r, Member TinyLog r ) => - UserId -> NewUserScimInvitation -> ExceptT Error.Error (AppT r) UserAccount -createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail _) = do +createUserInviteViaScim (NewUserScimInvitation tid uid loc name rawEmail _) = do email <- either (const . throwE . Error.StdError $ errorToWai @'E.InvalidEmail) pure (validateEmail rawEmail) let emKey = userEmailKey email verifyUniquenessAndCheckBlacklist emKey !>> identityErrorToBrigError diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index a163240fd13..a98512e25d7 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -161,7 +161,7 @@ createInvitationPublic uid tid body = do fst <$> logInvitationRequest context - (createInvitation' tid inviteeRole (Just (inviterUid inviter)) (inviterEmail inviter) body) + (createInvitation' tid Nothing inviteeRole (Just (inviterUid inviter)) (inviterEmail inviter) body) createInvitationViaScim :: ( Member BlacklistStore r, @@ -172,7 +172,7 @@ createInvitationViaScim :: TeamId -> NewUserScimInvitation -> (Handler r) UserAccount -createInvitationViaScim tid newUser@(NewUserScimInvitation _tid loc name email role) = do +createInvitationViaScim tid newUser@(NewUserScimInvitation _tid uid loc name email role) = do env <- ask let inviteeRole = role fromEmail = env ^. emailSender @@ -190,12 +190,11 @@ createInvitationViaScim tid newUser@(NewUserScimInvitation _tid loc name email r . logTeam tid . logEmail email - (inv, _) <- + void $ logInvitationRequest context $ - createInvitation' tid inviteeRole Nothing fromEmail invreq - let uid = Id (toUUID (inInvitation inv)) + createInvitation' tid (Just uid) inviteeRole Nothing fromEmail invreq - createUserInviteViaScim uid newUser + createUserInviteViaScim newUser logInvitationRequest :: (Msg -> Msg) -> (Handler r) (Invitation, InvitationCode) -> (Handler r) (Invitation, InvitationCode) logInvitationRequest context action = @@ -214,12 +213,13 @@ createInvitation' :: Member GalleyProvider r ) => TeamId -> + Maybe UserId -> Public.Role -> Maybe UserId -> Email -> Public.InvitationRequest -> Handler r (Public.Invitation, Public.InvitationCode) -createInvitation' tid inviteeRole mbInviterUid fromEmail body = do +createInvitation' tid mUid inviteeRole mbInviterUid fromEmail body = do -- FUTUREWORK: These validations are nearly copy+paste from accountCreation and -- sendActivationCode. Refactor this to a single place @@ -254,7 +254,7 @@ createInvitation' tid inviteeRole mbInviterUid fromEmail body = do showInvitationUrl <- lift $ liftSem $ GalleyProvider.getExposeInvitationURLsToTeamAdmin tid lift $ do - iid <- liftIO DB.mkInvitationId + iid <- maybe (liftIO DB.mkInvitationId) (pure . Id . toUUID) mUid now <- liftIO =<< view currentTime timeout <- setTeamInvitationTimeout <$> view settings (newInv, code) <- diff --git a/services/spar/spar.cabal b/services/spar/spar.cabal index 548c1f2ceff..3b15efd6505 100644 --- a/services/spar/spar.cabal +++ b/services/spar/spar.cabal @@ -39,6 +39,7 @@ library Spar.Schema.V15 Spar.Schema.V16 Spar.Schema.V17 + Spar.Schema.V18 Spar.Schema.V2 Spar.Schema.V3 Spar.Schema.V4 diff --git a/services/spar/src/Spar/Data/Instances.hs b/services/spar/src/Spar/Data/Instances.hs index f0b21768d22..3e395953898 100644 --- a/services/spar/src/Spar/Data/Instances.hs +++ b/services/spar/src/Spar/Data/Instances.hs @@ -37,6 +37,7 @@ import Data.X509 (SignedCertificate) import Imports import SAML2.Util (parseURI') import qualified SAML2.WebSSO as SAML +import Spar.Scim.Types (ScimUserCreationStatus (..)) import Text.XML.DSig (parseKeyInfo, renderKeyInfo) import URI.ByteString import Wire.API.User.Saml @@ -117,3 +118,15 @@ instance Cql ScimTokenLookupKey where fromCql s@(CqlText _) = ScimTokenLookupKeyHashed <$> fromCql s <|> ScimTokenLookupKeyPlaintext <$> fromCql s fromCql _ = Left "ScimTokenLookupKey: expected CqlText" + +instance Cql ScimUserCreationStatus where + ctype = Tagged IntColumn + + toCql ScimUserCreated = CqlInt 0 + toCql ScimUserCreating = CqlInt 1 + + fromCql (CqlInt i) = case i of + 0 -> pure ScimUserCreated + 1 -> pure ScimUserCreating + n -> Left $ "unexpected ScimUserCreationStatus: " ++ show n + fromCql _ = Left "int expected" diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index db6ea684d2d..d2a97b56dcc 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -130,14 +130,15 @@ createBrigUserSAML uref (Id buid) teamid name managedBy handle richInfo mLocale createBrigUserNoSAML :: (HasCallStack, MonadSparToBrig m) => Email -> + UserId -> TeamId -> -- | User name Name -> Maybe Locale -> Role -> m UserId -createBrigUserNoSAML email teamid uname locale role = do - let newUser = NewUserScimInvitation teamid locale uname email role +createBrigUserNoSAML email uid teamid uname locale role = do + let newUser = NewUserScimInvitation teamid uid locale uname email role resp :: ResponseLBS <- call $ method POST diff --git a/services/spar/src/Spar/Schema/Run.hs b/services/spar/src/Spar/Schema/Run.hs index a853c1c13c3..ac273fb83c4 100644 --- a/services/spar/src/Spar/Schema/Run.hs +++ b/services/spar/src/Spar/Schema/Run.hs @@ -31,6 +31,7 @@ import qualified Spar.Schema.V14 as V14 import qualified Spar.Schema.V15 as V15 import qualified Spar.Schema.V16 as V16 import qualified Spar.Schema.V17 as V17 +import qualified Spar.Schema.V18 as V18 import qualified Spar.Schema.V2 as V2 import qualified Spar.Schema.V3 as V3 import qualified Spar.Schema.V4 as V4 @@ -76,7 +77,8 @@ migrations = V14.migration, V15.migration, V16.migration, - V17.migration + V17.migration, + V18.migration -- TODO: Add a migration that removes unused fields -- (we don't want to risk running a migration which would -- effectively break the currently deployed spar service) diff --git a/services/spar/src/Spar/Schema/V18.hs b/services/spar/src/Spar/Schema/V18.hs new file mode 100644 index 00000000000..89f3bde2137 --- /dev/null +++ b/services/spar/src/Spar/Schema/V18.hs @@ -0,0 +1,33 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Spar.Schema.V18 + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = Migration 18 "A status field to manage user creation" $ do + void $ + schema' + [r| + ALTER TABLE scim_external ADD creation_status int; + |] diff --git a/services/spar/src/Spar/Scim/Types.hs b/services/spar/src/Spar/Scim/Types.hs index abda3fb9a81..5877b7884a2 100644 --- a/services/spar/src/Spar/Scim/Types.hs +++ b/services/spar/src/Spar/Scim/Types.hs @@ -30,8 +30,10 @@ -- * Request and response types for SCIM-related endpoints. module Spar.Scim.Types where +import Brig.Types.Test.Arbitrary (Arbitrary (..)) import Control.Lens (view) import Imports +import Test.QuickCheck.Gen (elements) import qualified Web.Scim.Schema.Common as Scim import qualified Web.Scim.Schema.User as Scim.User import Wire.API.User (AccountStatus (..)) @@ -87,3 +89,9 @@ normalizeLikeStored usr = tweakActive :: Maybe Scim.ScimBool -> Maybe Scim.ScimBool tweakActive = Just . Scim.ScimBool . maybe True Scim.unScimBool + +data ScimUserCreationStatus = ScimUserCreating | ScimUserCreated + deriving (Eq, Show, Generic) + +instance Arbitrary ScimUserCreationStatus where + arbitrary = elements [ScimUserCreating, ScimUserCreated] diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 46bb2fcce41..c8792a6e977 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -45,7 +45,7 @@ where import qualified Control.Applicative as Applicative (empty) import Control.Lens hiding (op) import Control.Monad.Error.Class (MonadError) -import Control.Monad.Except (throwError) +import Control.Monad.Except (throwError, withExceptT) import Control.Monad.Trans.Except (mapExceptT) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) import Crypto.Hash (Digest, SHA256, hashlazy) @@ -66,12 +66,14 @@ import Polysemy.Input import qualified SAML2.WebSSO as SAML import Spar.App (getUserByUrefUnsafe, getUserByUrefViaOldIssuerUnsafe, getUserIdByScimExternalId) import qualified Spar.App +import Spar.Intra.BrigApp as Intra import qualified Spar.Intra.BrigApp as Brig import Spar.Options import Spar.Scim.Auth () -import Spar.Scim.Types (normalizeLikeStored) +import Spar.Scim.Types import qualified Spar.Scim.Types as ST -import Spar.Sem.BrigAccess as BrigAccess +import Spar.Sem.BrigAccess (BrigAccess) +import qualified Spar.Sem.BrigAccess as BrigAccess import Spar.Sem.GalleyAccess as GalleyAccess import Spar.Sem.IdPConfigStore (IdPConfigStore) import qualified Spar.Sem.IdPConfigStore as IdPConfigStore @@ -457,7 +459,8 @@ createValidScimUser :: Member BrigAccess r, Member ScimExternalIdStore r, Member ScimUserTimesStore r, - Member SAMLUserStore r + Member SAMLUserStore r, + Member IdPConfigStore r ) => ScimTokenInfo -> ST.ValidScimUser -> @@ -470,37 +473,50 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid ) logScimUserId $ do + lift (ScimExternalIdStore.lookupStatus stiTeam veid) >>= \case + Just (buid, ScimUserCreated) -> + -- If the user has been created, but can't be found in brig anymore, + -- the invitation has timed out and the user has been deleted on brig's side. + -- If this is the case we can safely create the user again. + -- Otherwise we return a conflict error. + lift (BrigAccess.getStatusMaybe buid) >>= \case + Just Active -> throwError externalIdTakenError + Just Suspended -> throwError externalIdTakenError + Just Ephemeral -> throwError externalIdTakenError + Just PendingInvitation -> throwError externalIdTakenError + Just Deleted -> pure () + Nothing -> pure () + Just (buid, ScimUserCreating) -> + incompleteUserCreationCleanUp buid externalIdTakenError + Nothing -> pure () + -- ensure uniqueness constraints of all affected identifiers. -- {if we crash now, retry POST will just work} assertExternalIdUnused stiTeam veid assertHandleUnused handl -- {if we crash now, retry POST will just work, or user gets told the handle -- is already in use and stops POSTing} + buid <- lift $ Id <$> Random.uuid - -- Generate a UserId will be used both for scim user in spar and for brig. - buid <- - lift $ do - buid <- - ST.runValidExternalIdEither - ( \uref -> - do - -- FUTUREWORK: outsource this and some other fragments from - -- `createValidScimUser` into a function `createValidScimUserBrig` similar - -- to `createValidScimUserSpar`? - uid <- Id <$> Random.uuid - BrigAccess.createSAML uref uid stiTeam name ManagedByScim (Just handl) (Just richInfo) language (fromMaybe defaultRole role) - ) - ( \email -> do - buid <- BrigAccess.createNoSAML email stiTeam name language (fromMaybe defaultRole role) - BrigAccess.setHandle buid handl -- FUTUREWORK: possibly do the same one req as we do for saml? - pure buid - ) - veid + lift $ ScimExternalIdStore.insertStatus stiTeam veid buid ScimUserCreating - Logger.debug ("createValidScimUser: brig says " <> show buid) + -- Generate a UserId will be used both for scim user in spar and for brig. + lift $ do + ST.runValidExternalIdEither + ( \uref -> + -- FUTUREWORK: outsource this and some other fragments from + -- `createValidScimUser` into a function `createValidScimUserBrig` similar + -- to `createValidScimUserSpar`? + void $ BrigAccess.createSAML uref buid stiTeam name ManagedByScim (Just handl) (Just richInfo) language (fromMaybe defaultRole role) + ) + ( \email -> do + void $ BrigAccess.createNoSAML email buid stiTeam name language (fromMaybe defaultRole role) + BrigAccess.setHandle buid handl -- FUTUREWORK: possibly do the same one req as we do for saml? + ) + veid + Logger.debug ("createValidScimUser: brig says " <> show buid) - BrigAccess.setRichInfo buid richInfo - pure buid + BrigAccess.setRichInfo buid richInfo -- {If we crash now, a POST retry will fail with 409 user already exists. -- Azure at some point will retry with GET /Users?filter=userName eq handle @@ -530,7 +546,22 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid let new = ST.scimActiveFlagToAccountStatus old (Scim.unScimBool <$> active) active = Scim.active . Scim.value . Scim.thing $ storedUser when (new /= old) $ BrigAccess.setStatus buid new + + lift $ ScimExternalIdStore.insertStatus stiTeam veid buid ScimUserCreated pure storedUser + where + incompleteUserCreationCleanUp :: UserId -> Scim.ScimError -> Scim.ScimHandler (Sem r) () + incompleteUserCreationCleanUp buid e = do + -- something went wrong while storing the user in brig + -- we can try clean up now, but if brig is down, we can't do much + -- maybe retrying the user creation in brig is also an option? + -- after clean up we rethrow the error so the handler returns the correct failure + lift $ Logger.warn $ Log.msg @Text "An earlier attempt of creating a user with this external ID has failed and left some inconsistent data. Attempting to clean up." + withExceptT (const e) $ deleteScimUser tokeninfo buid + lift $ Logger.info $ Log.msg @Text "Clean up successful." + + externalIdTakenError :: Scim.ScimError + externalIdTakenError = Scim.conflict {Scim.detail = Just "ExternalId is already taken"} -- | Store scim timestamps, saml credentials, scim externalId locally in spar. Table -- `spar.scim_external` gets an entry iff there is no `UserRef`: if there is, we don't do a diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 8fd12220ee8..450edf7564e 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -62,7 +62,7 @@ import Wire.API.User.Scim (ValidExternalId (..)) data BrigAccess m a where CreateSAML :: SAML.UserRef -> UserId -> TeamId -> Name -> ManagedBy -> Maybe Handle -> Maybe RichInfo -> Maybe Locale -> Role -> BrigAccess m UserId - CreateNoSAML :: Email -> TeamId -> Name -> Maybe Locale -> Role -> BrigAccess m UserId + CreateNoSAML :: Email -> UserId -> TeamId -> Name -> Maybe Locale -> Role -> BrigAccess m UserId UpdateEmail :: UserId -> Email -> BrigAccess m () GetAccount :: HavePendingInvitations -> UserId -> BrigAccess m (Maybe UserAccount) GetByHandle :: Handle -> BrigAccess m (Maybe UserAccount) diff --git a/services/spar/src/Spar/Sem/BrigAccess/Http.hs b/services/spar/src/Spar/Sem/BrigAccess/Http.hs index 0331cca84d1..a1e5f8d04be 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -44,7 +44,7 @@ brigAccessToHttp mgr req = interpret $ viaRunHttp (RunHttpEnv mgr req) . \case CreateSAML u itlu itlt n m h ri ml r -> Intra.createBrigUserSAML u itlu itlt n m h ri ml r - CreateNoSAML e itlt n ml r -> Intra.createBrigUserNoSAML e itlt n ml r + CreateNoSAML e uid itlt n ml r -> Intra.createBrigUserNoSAML e uid itlt n ml r UpdateEmail itlu e -> Intra.updateEmail itlu e GetAccount h itlu -> Intra.getBrigUserAccount h itlu GetByHandle h -> Intra.getBrigUserByHandle h diff --git a/services/spar/src/Spar/Sem/ScimExternalIdStore.hs b/services/spar/src/Spar/Sem/ScimExternalIdStore.hs index 7ea4fe759c5..604c089d393 100644 --- a/services/spar/src/Spar/Sem/ScimExternalIdStore.hs +++ b/services/spar/src/Spar/Sem/ScimExternalIdStore.hs @@ -22,6 +22,8 @@ module Spar.Sem.ScimExternalIdStore insert, lookup, delete, + insertStatus, + lookupStatus, ) where @@ -29,12 +31,17 @@ import Data.Id (TeamId, UserId) import Imports (Maybe, Show) import Polysemy import Polysemy.Check (deriveGenericK) +import Spar.Scim.Types import Wire.API.User.Identity (Email) +import Wire.API.User.Scim data ScimExternalIdStore m a where Insert :: TeamId -> Email -> UserId -> ScimExternalIdStore m () Lookup :: TeamId -> Email -> ScimExternalIdStore m (Maybe UserId) Delete :: TeamId -> Email -> ScimExternalIdStore m () + -- NB: the fact that we are using `Email` in some cases here and `ValidExternalId` in others has historical reasons (this table was only used for non-saml accounts in the past, now it is used for *all* scim-managed accounts). the interface would work equally well with just `Text` here (for unvalidated scim external id). + InsertStatus :: TeamId -> ValidExternalId -> UserId -> ScimUserCreationStatus -> ScimExternalIdStore m () + LookupStatus :: TeamId -> ValidExternalId -> ScimExternalIdStore m (Maybe (UserId, ScimUserCreationStatus)) deriving instance Show (ScimExternalIdStore m a) diff --git a/services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs b/services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs index 6dad02d5fad..73c192dafdf 100644 --- a/services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs +++ b/services/spar/src/Spar/Sem/ScimExternalIdStore/Cassandra.hs @@ -23,11 +23,15 @@ module Spar.Sem.ScimExternalIdStore.Cassandra where import Cassandra +import Data.Bifunctor (second) import Data.Id import Imports import Polysemy +import Spar.Data.Instances () +import Spar.Scim.Types (ScimUserCreationStatus (ScimUserCreated)) import Spar.Sem.ScimExternalIdStore (ScimExternalIdStore (..)) import Wire.API.User.Identity +import Wire.API.User.Scim (ValidExternalId, runValidExternalIdUnsafe) scimExternalIdStoreToCassandra :: forall m r a. @@ -40,6 +44,8 @@ scimExternalIdStoreToCassandra = Insert tid em uid -> insertScimExternalId tid em uid Lookup tid em -> lookupScimExternalId tid em Delete tid em -> deleteScimExternalId tid em + InsertStatus tid veid buid status -> insertScimExternalIdStatus tid veid buid status + LookupStatus tid veid -> lookupScimExternalIdStatus tid veid -- | If a scim externalId does not have an associated saml idp issuer, it cannot be stored in -- table @spar.user@. In those cases, and only in those cases, we store the mapping to @@ -67,3 +73,19 @@ deleteScimExternalId tid (fromEmail -> email) = where delete :: PrepQuery W (TeamId, Text) () delete = "DELETE FROM scim_external WHERE team = ? and external_id = ?" + +insertScimExternalIdStatus :: (HasCallStack, MonadClient m) => TeamId -> ValidExternalId -> UserId -> ScimUserCreationStatus -> m () +insertScimExternalIdStatus tid veid uid status = + retry x5 . write insert $ params LocalQuorum (tid, runValidExternalIdUnsafe veid, uid, status) + where + insert :: PrepQuery W (TeamId, Text, UserId, ScimUserCreationStatus) () + insert = "INSERT INTO scim_external (team, external_id, user, creation_status) VALUES (?, ?, ?, ?)" + +lookupScimExternalIdStatus :: (HasCallStack, MonadClient m) => TeamId -> ValidExternalId -> m (Maybe (UserId, ScimUserCreationStatus)) +lookupScimExternalIdStatus tid veid = do + mResult <- retry x1 . query1 sel $ params LocalQuorum (tid, runValidExternalIdUnsafe veid) + -- if the user exists and the status is not present, we assume the user was created successfully + pure $ mResult <&> second (fromMaybe ScimUserCreated) + where + sel :: PrepQuery R (TeamId, Text) (UserId, Maybe ScimUserCreationStatus) + sel = "SELECT user, creation_status FROM scim_external WHERE team = ? and external_id = ?" diff --git a/services/spar/src/Spar/Sem/ScimExternalIdStore/Mem.hs b/services/spar/src/Spar/Sem/ScimExternalIdStore/Mem.hs index 03b742c3a60..3af1a26437d 100644 --- a/services/spar/src/Spar/Sem/ScimExternalIdStore/Mem.hs +++ b/services/spar/src/Spar/Sem/ScimExternalIdStore/Mem.hs @@ -27,14 +27,18 @@ import qualified Data.Map as M import Imports import Polysemy import Polysemy.State +import Spar.Scim (runValidExternalIdUnsafe) +import Spar.Scim.Types (ScimUserCreationStatus) import Spar.Sem.ScimExternalIdStore -import Wire.API.User.Identity (Email) +import Wire.API.User (fromEmail) scimExternalIdStoreToMem :: Sem (ScimExternalIdStore ': r) a -> - Sem r (Map (TeamId, Email) UserId, a) + Sem r (Map (TeamId, Text) (UserId, Maybe ScimUserCreationStatus), a) scimExternalIdStoreToMem = (runState mempty .) $ reinterpret $ \case - Insert tid em uid -> modify $ M.insert (tid, em) uid - Lookup tid em -> gets $ M.lookup (tid, em) - Delete tid em -> modify $ M.delete (tid, em) + Insert tid em uid -> modify $ M.insert (tid, fromEmail em) (uid, Nothing) + Lookup tid em -> fmap fst <$> gets (M.lookup (tid, fromEmail em)) + Delete tid em -> modify $ M.delete (tid, fromEmail em) + InsertStatus tid veid uid status -> modify $ M.insert (tid, runValidExternalIdUnsafe veid) (uid, Just status) + LookupStatus tid veid -> ((=<<) (\(uid, mStatus) -> (uid,) <$> mStatus)) <$> gets (M.lookup (tid, runValidExternalIdUnsafe veid)) diff --git a/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs b/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs index 7593f11c7e9..38ad7834c00 100644 --- a/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs +++ b/services/spar/src/Spar/Sem/ScimExternalIdStore/Spec.hs @@ -24,6 +24,7 @@ import Data.Id import Imports import Polysemy import Polysemy.Check +import Spar.Scim.Types (ScimUserCreationStatus) import qualified Spar.Sem.ScimExternalIdStore as E import Test.Hspec import Test.Hspec.QuickCheck @@ -45,15 +46,17 @@ propsForInterpreter interpreter extract lower = do prop "insert/lookup" $ prop_insertLookup (Just $ show . void . extract) lower prop "insert/insert" $ prop_insertInsert (Just $ show . void . extract) lower +-- FUTUREWORK: Add prop tests for missing operations + -- | All the constraints we need to generalize properties in this module. -- A regular type synonym doesn't work due to dreaded impredicative -- polymorphism. class - (Arbitrary UserId, CoArbitrary UserId, Functor f, Member E.ScimExternalIdStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (Arbitrary UserId, CoArbitrary UserId, Arbitrary ScimUserCreationStatus, CoArbitrary ScimUserCreationStatus, Functor f, Member E.ScimExternalIdStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => PropConstraints r f instance - (CoArbitrary UserId, Functor f, Member E.ScimExternalIdStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => + (CoArbitrary UserId, CoArbitrary ScimUserCreationStatus, Functor f, Member E.ScimExternalIdStore r, forall z. Show z => Show (f z), forall z. Eq z => Eq (f z)) => PropConstraints r f prop_insertLookup :: diff --git a/services/spar/test/Arbitrary.hs b/services/spar/test/Arbitrary.hs index 44d8f38ddac..1908c2c3dff 100644 --- a/services/spar/test/Arbitrary.hs +++ b/services/spar/test/Arbitrary.hs @@ -31,6 +31,7 @@ import SAML2.WebSSO.Test.Arbitrary () import SAML2.WebSSO.Types import Servant.API.ContentTypes import Spar.Scim +import Spar.Scim.Types (ScimUserCreationStatus) import qualified Spar.Sem.IdPConfigStore as E import Test.QuickCheck import URI.ByteString @@ -115,3 +116,5 @@ instance CoArbitrary (IdPConfig WireIdP) instance CoArbitrary IdPMetadata where coarbitrary = coarbitrary . show + +instance CoArbitrary ScimUserCreationStatus diff --git a/services/spar/test/Test/Spar/Intra/BrigSpec.hs b/services/spar/test/Test/Spar/Intra/BrigSpec.hs index 2b993e38bf5..129ba720eca 100644 --- a/services/spar/test/Test/Spar/Intra/BrigSpec.hs +++ b/services/spar/test/Test/Spar/Intra/BrigSpec.hs @@ -20,7 +20,6 @@ module Test.Spar.Intra.BrigSpec where import Arbitrary () -import Control.Lens ((^.)) import Imports import SAML2.WebSSO as SAML import Spar.Intra.BrigApp @@ -70,12 +69,3 @@ spec = do it "roundtrips" . property $ \(x :: ValidExternalId) -> (veidFromUserSSOId @(Either String) . veidToUserSSOId) x === Right x - -instance Arbitrary ValidExternalId where - arbitrary = do - muref <- arbitrary - case muref of - Just uref -> case emailFromSAMLNameID $ uref ^. SAML.uidSubject of - Just email -> pure $ EmailAndUref email uref - Nothing -> pure $ UrefOnly uref - Nothing -> EmailOnly <$> arbitrary