diff --git a/changelog.d/2-features/pr-2851 b/changelog.d/2-features/pr-2851 new file mode 100644 index 0000000000..3bd9a08c5d --- /dev/null +++ b/changelog.d/2-features/pr-2851 @@ -0,0 +1 @@ +A team member's role can now be provisioned via SCIM diff --git a/libs/brig-types/src/Brig/Types/Intra.hs b/libs/brig-types/src/Brig/Types/Intra.hs index 88bc7fda2e..6535aa9685 100644 --- a/libs/brig-types/src/Brig/Types/Intra.hs +++ b/libs/brig-types/src/Brig/Types/Intra.hs @@ -33,6 +33,7 @@ import qualified Data.Schema as Schema import qualified Data.Swagger as S import Imports import Test.QuickCheck (Arbitrary) +import Wire.API.Team.Role import Wire.API.User import Wire.Arbitrary (GenericUniform (..)) @@ -111,7 +112,8 @@ data NewUserScimInvitation = NewUserScimInvitation { newUserScimInvTeamId :: TeamId, newUserScimInvLocale :: Maybe Locale, newUserScimInvName :: Name, - newUserScimInvEmail :: Email + newUserScimInvEmail :: Email, + newUserScimInvRole :: Role } deriving (Eq, Show, Generic) @@ -122,12 +124,14 @@ instance FromJSON NewUserScimInvitation where <*> o .:? "locale" <*> o .: "name" <*> o .: "email" + <*> o .: "role" instance ToJSON NewUserScimInvitation where - toJSON (NewUserScimInvitation tid loc name email) = + toJSON (NewUserScimInvitation tid loc name email role) = object [ "team_id" .= tid, "locale" .= loc, "name" .= name, - "email" .= email + "email" .= email, + "role" .= role ] diff --git a/libs/brig-types/test/unit/Test/Brig/Types/User.hs b/libs/brig-types/test/unit/Test/Brig/Types/User.hs index 2b2cb07eca..ce800cee80 100644 --- a/libs/brig-types/test/unit/Test/Brig/Types/User.hs +++ b/libs/brig-types/test/unit/Test/Brig/Types/User.hs @@ -66,7 +66,7 @@ instance Arbitrary ReAuthUser where arbitrary = ReAuthUser <$> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary NewUserScimInvitation where - arbitrary = NewUserScimInvitation <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + arbitrary = NewUserScimInvitation <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary testCaseUserAccount :: TestTree testCaseUserAccount = testCase "UserAcccount" $ do diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs index 0df82c7912..08af13b115 100644 --- a/libs/wire-api/src/Wire/API/User.hs +++ b/libs/wire-api/src/Wire/API/User.hs @@ -165,6 +165,7 @@ import qualified Wire.API.Error.Brig as E import Wire.API.Provider.Service (ServiceRef, modelServiceRef) import Wire.API.Routes.MultiVerb import Wire.API.Team (BindingNewTeam, bindingNewTeamObjectSchema) +import Wire.API.Team.Role import Wire.API.User.Activation (ActivationCode) import Wire.API.User.Auth (CookieLabel) import Wire.API.User.Identity @@ -689,7 +690,8 @@ data NewUserSpar = NewUserSpar newUserSparManagedBy :: ManagedBy, newUserSparHandle :: Maybe Handle, newUserSparRichInfo :: Maybe RichInfo, - newUserSparLocale :: Maybe Locale + newUserSparLocale :: Maybe Locale, + newUserSparRole :: Role } deriving stock (Eq, Show, Generic) deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewUserSpar) @@ -714,6 +716,8 @@ instance ToSchema NewUserSpar where .= maybe_ (optField "newUserSparRichInfo" schema) <*> newUserSparLocale .= maybe_ (optField "newUserSparLocale" schema) + <*> newUserSparRole + .= field "newUserSparRole" schema newUserFromSpar :: NewUserSpar -> NewUser newUserFromSpar new = diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs index 1576c0b311..27ce75cd20 100644 --- a/libs/wire-api/src/Wire/API/User/Scim.hs +++ b/libs/wire-api/src/Wire/API/User/Scim.hs @@ -84,6 +84,7 @@ import Web.Scim.Schema.Schema (Schema (CustomSchema)) import qualified Web.Scim.Schema.Schema as Scim import qualified Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User as Scim.User +import Wire.API.Team.Role (Role) import Wire.API.User.Identity (Email) import Wire.API.User.Profile as BT import qualified Wire.API.User.RichInfo as RI @@ -326,7 +327,8 @@ data ValidScimUser = ValidScimUser _vsuName :: BT.Name, _vsuRichInfo :: RI.RichInfo, _vsuActive :: Bool, - _vsuLocale :: Maybe Locale + _vsuLocale :: Maybe Locale, + _vsuRole :: Role } deriving (Eq, Show) diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index b0a991140c..ac1a0a0eec 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -256,7 +256,7 @@ createUserSpar new = do pure account -- Add to team - userTeam <- withExceptT CreateUserSparRegistrationError $ addUserToTeamSSO account tid (SSOIdentity ident Nothing Nothing) + userTeam <- withExceptT CreateUserSparRegistrationError $ addUserToTeamSSO account tid (SSOIdentity ident Nothing Nothing) (newUserSparRole new) -- Set up feature flags let uid = userId (accountUser account) @@ -274,10 +274,10 @@ createUserSpar new = do Just handl -> withExceptT CreateUserSparHandleError $ changeHandle uid Nothing handl AllowSCIMUpdates Nothing -> throwE $ CreateUserSparHandleError ChangeHandleInvalid - addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> ExceptT RegisterError (AppT r) CreateUserTeam - addUserToTeamSSO account tid ident = do + addUserToTeamSSO :: UserAccount -> TeamId -> UserIdentity -> Role -> ExceptT RegisterError (AppT r) CreateUserTeam + addUserToTeamSSO account tid ident role = do let uid = userId (accountUser account) - added <- lift $ liftSem $ GalleyProvider.addTeamMember uid tid (Nothing, defaultRole) + added <- lift $ liftSem $ GalleyProvider.addTeamMember uid tid (Nothing, role) unless added $ throwE RegisterErrorTooManyTeamMembers lift $ do @@ -538,13 +538,14 @@ initAccountFeatureConfig uid = do createUserInviteViaScim :: Members '[ BlacklistStore, - UserPendingActivationStore p + UserPendingActivationStore p, + GalleyProvider ] r => UserId -> NewUserScimInvitation -> ExceptT Error.Error (AppT r) UserAccount -createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = do +createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail _) = do email <- either (const . throwE . Error.StdError $ errorToWai @'E.InvalidEmail) pure (validateEmail rawEmail) let emKey = userEmailKey email verifyUniquenessAndCheckBlacklist emKey !>> identityErrorToBrigError @@ -565,7 +566,6 @@ createUserInviteViaScim uid (NewUserScimInvitation tid loc name rawEmail) = do -- the SCIM user. True lift . wrapClient $ Data.insertAccount account Nothing Nothing activated - pure account -- | docs/reference/user/registration.md {#RefRestrictRegistration}. diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index 6411626417..d5814a1116 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -231,9 +231,9 @@ createInvitationViaScim :: r => NewUserScimInvitation -> (Handler r) UserAccount -createInvitationViaScim newUser@(NewUserScimInvitation tid loc name email) = do +createInvitationViaScim newUser@(NewUserScimInvitation tid loc name email role) = do env <- ask - let inviteeRole = defaultRole + let inviteeRole = role fromEmail = env ^. emailSender invreq = InvitationRequest diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index b2e55a7bce..b4054414a1 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -357,6 +357,17 @@ type ITeamsAPIBase = :> CanThrow 'TooManyTeamMembersOnTeamWithLegalhold :> MultiVerb1 'GET '[Servant.JSON] (RespondEmpty 200 "User can join") ) + :<|> Named + "unchecked-update-team-member" + ( CanThrow 'AccessDenied + :> CanThrow 'InvalidPermissions + :> CanThrow 'TeamNotFound + :> CanThrow 'TeamMemberNotFound + :> CanThrow 'NotATeamMember + :> CanThrow OperationDenied + :> ReqBody '[Servant.JSON] NewTeamMember + :> MultiVerb1 'PUT '[Servant.JSON] (RespondEmpty 200 "") + ) ) :<|> Named "user-is-team-owner" @@ -486,6 +497,7 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler id (base tid) <@> mkNamedAPI @"unchecked-get-team-members" (Teams.uncheckedGetTeamMembersH tid) <@> mkNamedAPI @"unchecked-get-team-member" (Teams.uncheckedGetTeamMember tid) <@> mkNamedAPI @"can-user-join-team" (Teams.canUserJoinTeam @Cassandra tid) + <@> mkNamedAPI @"unchecked-update-team-member" (Teams.uncheckedUpdateTeamMember Nothing Nothing tid) ) <@> mkNamedAPI @"user-is-team-owner" (Teams.userIsTeamOwner tid) <@> hoistAPISegment diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 7e79d38213..acff3286cf 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -50,6 +50,7 @@ module Galley.API.Teams uncheckedGetTeamMember, uncheckedGetTeamMembersH, uncheckedDeleteTeamMember, + uncheckedUpdateTeamMember, userIsTeamOwner, canUserJoinTeam, ensureNotTooLargeForLegalHold, @@ -766,7 +767,7 @@ uncheckedAddTeamMember tid nmem = do billingUserIds <- Journal.getBillingUserIds tid $ Just $ newTeamMemberList (ntmNewTeamMember nmem : mems ^. teamMembers) (mems ^. teamMemberListType) Journal.teamUpdate tid (sizeBeforeAdd + 1) billingUserIds -updateTeamMember :: +uncheckedUpdateTeamMember :: forall r. Members '[ BrigAccess, @@ -783,13 +784,13 @@ updateTeamMember :: TeamStore ] r => - Local UserId -> - ConnId -> + Maybe (Local UserId) -> + Maybe ConnId -> TeamId -> NewTeamMember -> Sem r () -updateTeamMember lzusr zcon tid newMember = do - let zusr = tUnqualified lzusr +uncheckedUpdateTeamMember mlzusr mZcon tid newMember = do + let mZusr = tUnqualified <$> mlzusr let targetMember = ntmNewTeamMember newMember let targetId = targetMember ^. userId targetPermissions = targetMember ^. permissions @@ -797,36 +798,18 @@ updateTeamMember lzusr zcon tid newMember = do Log.field "targets" (toByteString targetId) . Log.field "action" (Log.val "Teams.updateTeamMember") - -- get the team and verify permissions team <- fmap tdTeam $ E.getTeam tid >>= noteS @'TeamNotFound - user <- - E.getTeamMember tid zusr - >>= permissionCheck SetMemberPermissions - -- user may not elevate permissions - targetPermissions `ensureNotElevated` user previousMember <- E.getTeamMember tid targetId >>= noteS @'TeamMemberNotFound - when - ( downgradesOwner previousMember targetPermissions - && not (canDowngradeOwner user previousMember) - ) - $ throwS @'AccessDenied -- update target in Cassandra E.setTeamMemberPermissions (previousMember ^. permissions) tid targetId targetPermissions updatedMembers <- getTeamMembersForFanout tid updateJournal team updatedMembers - updatePeers zusr targetId targetMember targetPermissions updatedMembers + updatePeers mZusr targetId targetMember targetPermissions updatedMembers where - canDowngradeOwner = canDeleteMember - - downgradesOwner :: TeamMember -> Permissions -> Bool - downgradesOwner previousMember targetPermissions = - permissionsRole (previousMember ^. permissions) == Just RoleOwner - && permissionsRole targetPermissions /= Just RoleOwner - updateJournal :: Team -> TeamMemberList -> Sem r () updateJournal team mems = do when (team ^. teamBinding == Binding) $ do @@ -834,7 +817,7 @@ updateTeamMember lzusr zcon tid newMember = do billingUserIds <- Journal.getBillingUserIds tid $ Just mems Journal.teamUpdate tid size billingUserIds - updatePeers :: UserId -> UserId -> TeamMember -> Permissions -> TeamMemberList -> Sem r () + updatePeers :: Maybe UserId -> UserId -> TeamMember -> Permissions -> TeamMemberList -> Sem r () updatePeers zusr targetId targetMember targetPermissions updatedMembers = do -- inform members of the team about the change -- some (privileged) users will be informed about which change was applied @@ -845,8 +828,63 @@ updateTeamMember lzusr zcon tid newMember = do now <- input let ePriv = newEvent tid now privilegedUpdate -- push to all members (user is privileged) - let pushPriv = newPushLocal (updatedMembers ^. teamMemberListType) zusr (TeamEvent ePriv) $ privilegedRecipients - for_ pushPriv $ \p -> E.push1 $ p & pushConn ?~ zcon + let pushPriv = newPush (updatedMembers ^. teamMemberListType) zusr (TeamEvent ePriv) $ privilegedRecipients + for_ pushPriv (\p -> E.push1 (p & pushConn .~ mZcon)) + +updateTeamMember :: + forall r. + Members + '[ BrigAccess, + ErrorS 'AccessDenied, + ErrorS 'InvalidPermissions, + ErrorS 'TeamNotFound, + ErrorS 'TeamMemberNotFound, + ErrorS 'NotATeamMember, + ErrorS OperationDenied, + GundeckAccess, + Input Opts, + Input UTCTime, + P.TinyLog, + TeamStore + ] + r => + Local UserId -> + ConnId -> + TeamId -> + NewTeamMember -> + Sem r () +updateTeamMember lzusr zcon tid newMember = do + let zusr = tUnqualified lzusr + let targetMember = ntmNewTeamMember newMember + let targetId = targetMember ^. userId + targetPermissions = targetMember ^. permissions + P.debug $ + Log.field "targets" (toByteString targetId) + . Log.field "action" (Log.val "Teams.updateTeamMember") + + -- get the team and verify permissions + user <- + E.getTeamMember tid zusr + >>= permissionCheck SetMemberPermissions + + -- user may not elevate permissions + targetPermissions `ensureNotElevated` user + previousMember <- + E.getTeamMember tid targetId >>= noteS @'TeamMemberNotFound + when + ( downgradesOwner previousMember targetPermissions + && not (canDowngradeOwner user previousMember) + ) + $ throwS @'AccessDenied + + uncheckedUpdateTeamMember (Just lzusr) (Just zcon) tid newMember + where + canDowngradeOwner = canDeleteMember + + downgradesOwner :: TeamMember -> Permissions -> Bool + downgradesOwner previousMember targetPermissions = + permissionsRole (previousMember ^. permissions) == Just RoleOwner + && permissionsRole targetPermissions /= Just RoleOwner deleteTeamMember :: Members diff --git a/services/spar/src/Spar/App.hs b/services/spar/src/Spar/App.hs index 7edc345b28..429eac99c0 100644 --- a/services/spar/src/Spar/App.hs +++ b/services/spar/src/Spar/App.hs @@ -85,6 +85,7 @@ import qualified Spar.Sem.VerdictFormatStore as VerdictFormatStore import qualified System.Logger as TinyLog import URI.ByteString as URI import Web.Cookie (SetCookie, renderSetCookie) +import Wire.API.Team.Role (Role, defaultRole) import Wire.API.User hiding (validateEmail) import Wire.API.User.IdentityProvider import Wire.API.User.Saml @@ -166,10 +167,11 @@ createSamlUserWithId :: TeamId -> UserId -> SAML.UserRef -> + Role -> Sem r () -createSamlUserWithId teamid buid suid = do +createSamlUserWithId teamid buid suid role = do uname <- either (throwSparSem . SparBadUserName . cs) pure $ Intra.mkUserName Nothing (UrefOnly suid) - buid' <- BrigAccess.createSAML suid buid teamid uname ManagedByWire Nothing Nothing Nothing + buid' <- BrigAccess.createSAML suid buid teamid uname ManagedByWire Nothing Nothing Nothing role assert (buid == buid') $ pure () SAMLUserStore.insert suid buid @@ -194,7 +196,7 @@ autoprovisionSamlUser :: autoprovisionSamlUser idp buid suid = do guardReplacedIdP guardScimTokens - createSamlUserWithId (idp ^. idpExtraInfo . wiTeam) buid suid + createSamlUserWithId (idp ^. idpExtraInfo . wiTeam) buid suid defaultRole where -- Replaced IdPs are not allowed to create new wire accounts. guardReplacedIdP :: Sem r () diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index eae776c031..5ca89e612b 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -59,6 +59,7 @@ import qualified SAML2.WebSSO as SAML import Spar.Error import qualified System.Logger.Class as Log import Web.Cookie +import Wire.API.Team.Role (Role) import Wire.API.User import Wire.API.User.Auth.ReAuth import Wire.API.User.Auth.Sso @@ -99,8 +100,9 @@ createBrigUserSAML :: Maybe Handle -> Maybe RichInfo -> Maybe Locale -> + Role -> m UserId -createBrigUserSAML uref (Id buid) teamid name managedBy handle richInfo mLocale = do +createBrigUserSAML uref (Id buid) teamid name managedBy handle richInfo mLocale role = do let newUser = NewUserSpar { newUserSparUUID = buid, @@ -110,7 +112,8 @@ createBrigUserSAML uref (Id buid) teamid name managedBy handle richInfo mLocale newUserSparManagedBy = managedBy, newUserSparHandle = handle, newUserSparRichInfo = richInfo, - newUserSparLocale = mLocale + newUserSparLocale = mLocale, + newUserSparRole = role } resp :: ResponseLBS <- call $ @@ -128,9 +131,10 @@ createBrigUserNoSAML :: -- | User name Name -> Maybe Locale -> + Role -> m UserId -createBrigUserNoSAML email teamid uname locale = do - let newUser = NewUserScimInvitation teamid locale uname email +createBrigUserNoSAML email teamid uname locale role = do + let newUser = NewUserScimInvitation teamid locale uname email role resp :: ResponseLBS <- call $ method POST diff --git a/services/spar/src/Spar/Intra/Galley.hs b/services/spar/src/Spar/Intra/Galley.hs index 07b4454d76..a09eef5476 100644 --- a/services/spar/src/Spar/Intra/Galley.hs +++ b/services/spar/src/Spar/Intra/Galley.hs @@ -31,6 +31,7 @@ import Spar.Error import qualified System.Logger.Class as Log import Wire.API.Team.Feature import Wire.API.Team.Member +import Wire.API.Team.Role ---------------------------------------------------------------------- @@ -51,6 +52,24 @@ getTeamMembers tid = do then (^. teamMembers) <$> parseResponse @TeamMemberList "galley" resp else rethrow "galley" resp +-- | Get a single member of a team. +getTeamMember :: + (HasCallStack, MonadError SparError m, MonadSparToGalley m) => + TeamId -> + UserId -> + m (Maybe TeamMember) +getTeamMember tid uid = do + resp :: ResponseLBS <- + call $ + method GET + . paths ["i", "teams", toByteString' tid, "members", toByteString' uid] + if statusCode resp == 200 + then Just <$> parseResponse @TeamMember "galley" resp + else + if statusCode resp == 404 + then pure Nothing + else rethrow "galley" resp + -- | user is member of a given team and has a given permission there. assertHasPermission :: (HasCallStack, MonadSparToGalley m, MonadError SparError m, IsPerm perm, Show perm) => @@ -91,3 +110,20 @@ isEmailValidationEnabledTeam tid = do == Just FeatureStatusEnabled ) ) + +-- | Update a team member. +updateTeamMember :: + (MonadIO m, HasCallStack, MonadError SparError m, MonadSparToGalley m) => + UserId -> + TeamId -> + Role -> + m () +updateTeamMember u tid role = do + let reqBody = mkNewTeamMember u (rolePermissions role) Nothing + rs <- + call $ + method PUT + . paths ["i", "teams", toByteString' tid, "members"] + . contentJson + . json reqBody + print rs diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index 5026f98af4..c84279743d 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -45,7 +45,7 @@ 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.Lens hiding (op) import Control.Monad.Error.Class (MonadError) import Control.Monad.Except (runExceptT, throwError) import Control.Monad.Trans.Except (mapExceptT) @@ -53,12 +53,14 @@ import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) import Crypto.Hash (Digest, SHA256, hashlazy) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Text as Aeson +import Data.ByteString.Conversion (fromByteString, toByteString, toByteString') import Data.Handle (Handle (Handle), parseHandle) import Data.Id (Id (..), TeamId, UserId, idToText) import Data.Json.Util (UTCTimeMillis, fromUTCTimeMillis, toUTCTimeMillis) import Data.String.Conversions (cs) import qualified Data.Text as Text import qualified Data.UUID as UUID +import qualified Galley.Types.Teams as Galley import Imports import Network.URI (URI, parseURI) import Polysemy @@ -71,7 +73,7 @@ import Spar.Scim.Auth () import Spar.Scim.Types (normalizeLikeStored) import qualified Spar.Scim.Types as ST import Spar.Sem.BrigAccess as BrigAccess -import Spar.Sem.GalleyAccess (GalleyAccess) +import Spar.Sem.GalleyAccess as GalleyAccess import Spar.Sem.IdPConfigStore (IdPConfigStore) import qualified Spar.Sem.IdPConfigStore as IdPConfigStore import Spar.Sem.SAMLUserStore (SAMLUserStore) @@ -95,6 +97,8 @@ import qualified Web.Scim.Schema.Meta as Scim import qualified Web.Scim.Schema.ResourceType as Scim import qualified Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User as Scim.User (schemas) +import qualified Wire.API.Team.Member as Member +import Wire.API.Team.Role import Wire.API.User import Wire.API.User.IdentityProvider (IdP) import qualified Wire.API.User.RichInfo as RI @@ -257,11 +261,7 @@ validateScimUser' :: Scim.User ST.SparTag -> m ST.ValidScimUser validateScimUser' errloc midp richInfoLimit user = do - unless (isNothing $ Scim.password user) $ - throwError $ - Scim.badRequest - Scim.InvalidValue - (Just $ "Setting user passwords is not supported for security reasons. (" <> errloc <> ")") + unless (isNothing $ Scim.password user) $ throwError $ badRequest "Setting user passwords is not supported for security reasons." veid <- mkValidExternalId midp (Scim.externalId user) handl <- validateHandle . Text.toLower . Scim.userName $ user -- FUTUREWORK: 'Scim.userName' should be case insensitive; then the toLower here would @@ -271,9 +271,29 @@ validateScimUser' errloc midp richInfoLimit user = do either err pure $ Brig.mkUserName (Scim.displayName user) veid richInfo <- validateRichInfo (Scim.extra user ^. ST.sueRichInfo) let active = Scim.active user - lang <- maybe (error "Could not parse language. Expected format is ISO 639-1.") pure $ mapM parseLanguage $ Scim.preferredLanguage user - pure $ ST.ValidScimUser veid handl uname richInfo (maybe True Scim.unScimBool active) (flip Locale Nothing <$> lang) + lang <- maybe (throwError $ badRequest "Could not parse language. Expected format is ISO 639-1.") pure $ mapM parseLanguage $ Scim.preferredLanguage user + mRole <- validateRole user + pure $ ST.ValidScimUser veid handl uname richInfo (maybe True Scim.unScimBool active) (flip Locale Nothing <$> lang) (fromMaybe defaultRole mRole) where + validRoleNames :: Text + validRoleNames = cs $ intercalate ", " $ map (cs . toByteString') [minBound @Role .. maxBound] + + validateRole = + Scim.roles <&> \case + [] -> pure Nothing + [roleName] -> + maybe + (throwError $ badRequest $ "The role '" <> roleName <> "' is not valid. Valid roles are " <> validRoleNames <> ".") + (pure . Just) + (fromByteString $ cs roleName) + (_ : _ : _) -> throwError $ badRequest "A user cannot have more than one role." + + badRequest :: Text -> Scim.ScimError + badRequest msg = + Scim.badRequest + Scim.InvalidValue + (Just $ msg <> " (" <> errloc <> ")") + -- Validate rich info (@richInfo@). It must not exceed the rich info limit. validateRichInfo :: RI.RichInfo -> m RI.RichInfo validateRichInfo richInfo = do @@ -368,7 +388,7 @@ logEmail email = Log.field "email_sha256" (sha256String . cs . show $ email) logVSU :: ST.ValidScimUser -> (Msg -> Msg) -logVSU (ST.ValidScimUser veid handl _name _richInfo _active _lang) = +logVSU (ST.ValidScimUser veid handl _name _richInfo _active _lang _role) = maybe id logEmail (veidEmail veid) . logHandle handl @@ -423,7 +443,7 @@ createValidScimUser :: ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) -createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid handl name richInfo _active language) = +createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid handl name richInfo _active language role) = logScim ( logFunction "Spar.Scim.User.createValidScimUser" . logVSU vsu @@ -449,10 +469,10 @@ createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid -- `createValidScimUser` into a function `createValidScimUserBrig` similar -- to `createValidScimUserSpar`? uid <- Id <$> Random.uuid - BrigAccess.createSAML uref uid stiTeam name ManagedByScim (Just handl) (Just richInfo) language + BrigAccess.createSAML uref uid stiTeam name ManagedByScim (Just handl) (Just richInfo) language role ) ( \email -> do - buid <- BrigAccess.createNoSAML email stiTeam name language + buid <- BrigAccess.createNoSAML email stiTeam name language role BrigAccess.setHandle buid handl -- FUTUREWORK: possibly do the same one req as we do for saml? pure buid ) @@ -572,11 +592,8 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid nvsu = newScimStoredUser :: Scim.StoredUser ST.SparTag <- updScimStoredUser (synthesizeScimUser newValidScimUser) oldScimStoredUser - do - let old = oldValidScimUser ^. ST.vsuExternalId - new = newValidScimUser ^. ST.vsuExternalId - when (old /= new) $ - updateVsuUref stiTeam uid old new + when (oldValidScimUser ^. ST.vsuExternalId /= newValidScimUser ^. ST.vsuExternalId) $ + updateVsuUref stiTeam uid (oldValidScimUser ^. ST.vsuExternalId) (newValidScimUser ^. ST.vsuExternalId) when (newValidScimUser ^. ST.vsuName /= oldValidScimUser ^. ST.vsuName) $ BrigAccess.setName uid (newValidScimUser ^. ST.vsuName) @@ -590,6 +607,9 @@ updateValidScimUser tokinfo@ScimTokenInfo {stiTeam} uid nvsu = when (oldValidScimUser ^. ST.vsuLocale /= newValidScimUser ^. ST.vsuLocale) $ do BrigAccess.setLocale uid (newValidScimUser ^. ST.vsuLocale) + when (oldValidScimUser ^. ST.vsuRole /= newValidScimUser ^. ST.vsuRole) $ do + GalleyAccess.updateTeamMember uid stiTeam (newValidScimUser ^. ST.vsuRole) + BrigAccess.getStatusMaybe uid >>= \case Nothing -> pure () Just old -> do @@ -848,6 +868,7 @@ synthesizeStoredUser :: Now, Logger (Msg -> Msg), BrigAccess, + GalleyAccess, ScimUserTimesStore ] r => @@ -867,12 +888,13 @@ synthesizeStoredUser usr veid = let uid = userId (accountUser usr) accStatus = accountStatus usr - let readState :: Sem r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI) - readState = do - richInfo <- BrigAccess.getRichInfo uid - accessTimes <- ScimUserTimesStore.read uid - baseuri <- inputs $ derivedOptsScimBaseURI . derivedOpts - pure (richInfo, accessTimes, baseuri) + let readState :: Sem r (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI, Role) + readState = + (,,,) + <$> BrigAccess.getRichInfo uid + <*> ScimUserTimesStore.read uid + <*> inputs (derivedOptsScimBaseURI . derivedOpts) + <*> getRole let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Sem r () writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do @@ -884,7 +906,7 @@ synthesizeStoredUser usr veid = when (oldRichInfo /= newRichInfo) $ BrigAccess.setRichInfo uid newRichInfo - (richInfo, accessTimes, baseuri) <- lift readState + (richInfo, accessTimes, baseuri, role) <- lift readState now <- toUTCTimeMillis <$> lift Now.get let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes @@ -902,8 +924,14 @@ synthesizeStoredUser usr veid = lastUpdatedAt baseuri (userLocale (accountUser usr)) + role lift $ writeState accessTimes (userManagedBy (accountUser usr)) richInfo storedUser pure storedUser + where + getRole :: Sem r Role + getRole = do + let tmRoleOrDefault m = fromMaybe defaultRole $ m >>= \member -> member ^. Member.permissions . to Galley.permissionsRole + maybe (pure defaultRole) (\tid -> tmRoleOrDefault <$> GalleyAccess.getTeamMember tid (userId $ accountUser usr)) (userTeam $ accountUser usr) synthesizeStoredUser' :: UserId -> @@ -916,8 +944,9 @@ synthesizeStoredUser' :: UTCTimeMillis -> URIBS.URI -> Locale -> + Role -> MonadError Scim.ScimError m => m (Scim.StoredUser ST.SparTag) -synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpdatedAt baseuri locale = do +synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpdatedAt baseuri locale role = do let scimUser :: Scim.User ST.SparTag scimUser = synthesizeScimUser @@ -929,7 +958,8 @@ synthesizeStoredUser' uid veid dname handle richInfo accStatus createdAt lastUpd ST._vsuName = dname, ST._vsuRichInfo = richInfo, ST._vsuActive = ST.scimActiveFlagFromAccountStatus accStatus, - ST._vsuLocale = Just locale + ST._vsuLocale = Just locale, + ST._vsuRole = role } pure $ toScimStoredUser' createdAt lastUpdatedAt baseuri uid (normalizeLikeStored scimUser) @@ -941,12 +971,14 @@ synthesizeScimUser info = { Scim.externalId = Brig.renderValidExternalId $ info ^. ST.vsuExternalId, Scim.displayName = Just $ fromName (info ^. ST.vsuName), Scim.active = Just . Scim.ScimBool $ info ^. ST.vsuActive, - Scim.preferredLanguage = lan2Text . lLanguage <$> info ^. ST.vsuLocale + Scim.preferredLanguage = lan2Text . lLanguage <$> info ^. ST.vsuLocale, + Scim.roles = (: []) . cs . toByteString $ info ^. ST.vsuRole } getUserById :: forall r. ( Member BrigAccess r, + Member GalleyAccess r, Member (Input Opts) r, Member (Logger (Msg -> Msg)) r, Member Now r, @@ -993,6 +1025,7 @@ getUserById midp stiTeam uid = do scimFindUserByHandle :: forall r. ( Member BrigAccess r, + Member GalleyAccess r, Member (Input Opts) r, Member (Logger (Msg -> Msg)) r, Member Now r, @@ -1018,6 +1051,7 @@ scimFindUserByHandle mIdpConfig stiTeam hndl = do scimFindUserByEmail :: forall r. ( Member BrigAccess r, + Member GalleyAccess r, Member (Input Opts) r, Member (Logger (Msg -> Msg)) r, Member Now r, diff --git a/services/spar/src/Spar/Sem/BrigAccess.hs b/services/spar/src/Spar/Sem/BrigAccess.hs index 0e35976d5a..2d71f05387 100644 --- a/services/spar/src/Spar/Sem/BrigAccess.hs +++ b/services/spar/src/Spar/Sem/BrigAccess.hs @@ -53,6 +53,7 @@ import Imports import Polysemy import qualified SAML2.WebSSO as SAML import Web.Cookie +import Wire.API.Team.Role import Wire.API.User (DeleteUserResult, VerificationAction) import Wire.API.User.Identity import Wire.API.User.Profile @@ -60,8 +61,8 @@ import Wire.API.User.RichInfo as RichInfo import Wire.API.User.Scim (ValidExternalId (..)) data BrigAccess m a where - CreateSAML :: SAML.UserRef -> UserId -> TeamId -> Name -> ManagedBy -> Maybe Handle -> Maybe RichInfo -> Maybe Locale -> BrigAccess m UserId - CreateNoSAML :: Email -> TeamId -> Name -> Maybe Locale -> BrigAccess m UserId + 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 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 cbcafe8ad3..0cd47ba97d 100644 --- a/services/spar/src/Spar/Sem/BrigAccess/Http.hs +++ b/services/spar/src/Spar/Sem/BrigAccess/Http.hs @@ -40,8 +40,8 @@ brigAccessToHttp :: brigAccessToHttp mgr req = interpret $ viaRunHttp (RunHttpEnv mgr req) . \case - CreateSAML u itlu itlt n m h ri ml -> Intra.createBrigUserSAML u itlu itlt n m h ri ml - CreateNoSAML e itlt n ml -> Intra.createBrigUserNoSAML e itlt n ml + 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 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/GalleyAccess.hs b/services/spar/src/Spar/Sem/GalleyAccess.hs index 05ccc230ec..47d8d6c159 100644 --- a/services/spar/src/Spar/Sem/GalleyAccess.hs +++ b/services/spar/src/Spar/Sem/GalleyAccess.hs @@ -20,9 +20,11 @@ module Spar.Sem.GalleyAccess ( GalleyAccess (..), getTeamMembers, + getTeamMember, assertHasPermission, assertSSOEnabled, isEmailValidationEnabledTeam, + updateTeamMember, ) where @@ -31,11 +33,14 @@ import Galley.Types.Teams (IsPerm) import Imports import Polysemy import Wire.API.Team.Member +import Wire.API.Team.Role data GalleyAccess m a where GetTeamMembers :: TeamId -> GalleyAccess m [TeamMember] + GetTeamMember :: TeamId -> UserId -> GalleyAccess m (Maybe TeamMember) AssertHasPermission :: (Show perm, IsPerm perm) => TeamId -> perm -> UserId -> GalleyAccess m () AssertSSOEnabled :: TeamId -> GalleyAccess m () IsEmailValidationEnabledTeam :: TeamId -> GalleyAccess m Bool + UpdateTeamMember :: UserId -> TeamId -> Role -> GalleyAccess m () makeSem ''GalleyAccess diff --git a/services/spar/src/Spar/Sem/GalleyAccess/Http.hs b/services/spar/src/Spar/Sem/GalleyAccess/Http.hs index 4b4d40576c..f50e01bc25 100644 --- a/services/spar/src/Spar/Sem/GalleyAccess/Http.hs +++ b/services/spar/src/Spar/Sem/GalleyAccess/Http.hs @@ -43,6 +43,8 @@ galleyAccessToHttp mgr req = interpret $ viaRunHttp (RunHttpEnv mgr req) . \case GetTeamMembers itlt -> Intra.getTeamMembers itlt + GetTeamMember tid uid -> Intra.getTeamMember tid uid AssertHasPermission itlt perm itlu -> Intra.assertHasPermission itlt perm itlu AssertSSOEnabled itlt -> Intra.assertSSOEnabled itlt IsEmailValidationEnabledTeam itlt -> Intra.isEmailValidationEnabledTeam itlt + UpdateTeamMember uid tid role -> Intra.updateTeamMember uid tid role diff --git a/services/spar/test-integration/Test/Spar/APISpec.hs b/services/spar/test-integration/Test/Spar/APISpec.hs index 9e463aafbb..c2e5175354 100644 --- a/services/spar/test-integration/Test/Spar/APISpec.hs +++ b/services/spar/test-integration/Test/Spar/APISpec.hs @@ -24,6 +24,7 @@ module Test.Spar.APISpec where import Bilge +import Bilge.Assert import Brig.Types.Intra (AccountStatus (Deleted)) import Cassandra as Cas hiding (Value) import Control.Lens hiding ((.=)) @@ -105,6 +106,7 @@ spec = do specCRUDIdentityProvider specDeleteCornerCases specScimAndSAML + specProvisionScimAndSAMLUserWithRole specAux specSsoSettings specSparUserMigration @@ -1305,6 +1307,76 @@ specScimAndSAML = do liftIO $ mid `shouldBe` Just (ScimT.scimUserId scimStoredUser) +specProvisionScimAndSAMLUserWithRole :: SpecWith TestEnv +specProvisionScimAndSAMLUserWithRole = do + describe "provision scim user with SAML with role" $ do + it "create user" $ do + (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta + let testCreateUserWithRole role = do + scimUser <- do + u <- ScimT.randomScimUser + pure $ u {Scim.roles = [cs $ toByteString $ role]} + userId <- ScimT.scimUserId <$> ScimT.createUser tok scimUser + ScimT.checkTeamMembersRole tid owner userId role + mapM_ testCreateUserWithRole [minBound .. maxBound] + it "create user - default to member if no role given" $ do + (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta + scimUser <- do + u <- ScimT.randomScimUser + pure $ u {Scim.roles = []} + userId <- ScimT.scimUserId <$> ScimT.createUser tok scimUser + ScimT.checkTeamMembersRole tid owner userId RoleMember + it "create user - fail if more than one role given" $ do + (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta + scimUser <- do + u <- ScimT.randomScimUser + pure $ u {Scim.roles = ["member", "admin"]} + ScimT.createUser' tok scimUser !!! do + const 400 === statusCode + const (Just "A user cannot have more than one role.") =~= responseBody + it "create user - fail if role name cannot be parsed correctly" $ do + (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta + scimUser <- do + u <- ScimT.randomScimUser + pure $ u {Scim.roles = ["president"]} + ScimT.createUser' tok scimUser !!! do + const 400 === statusCode + const (Just "The role 'president' is not valid. Valid roles are owner, admin, member, partner.") =~= responseBody + it "update user" $ do + (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta + scimUserWithDefaultRole <- ScimT.randomScimUser + userId <- ScimT.scimUserId <$> ScimT.createUser tok scimUserWithDefaultRole + let testUpdateUserWithRole role = do + let scimUserWithRole = scimUserWithDefaultRole {Scim.roles = [cs $ toByteString $ role]} + _ <- ScimT.updateUser tok userId scimUserWithRole + ScimT.checkTeamMembersRole tid owner userId role + mapM_ testUpdateUserWithRole [minBound .. maxBound] + it "update user - default to member if no role given" $ do + (tok, (owner, tid, _idp, (_, _privcreds))) <- ScimT.registerIdPAndScimTokenWithMeta + let testUpdateUserWithDefaultRole :: Role -> TestSpar () + testUpdateUserWithDefaultRole role = do + scimUser <- do + u <- ScimT.randomScimUser + pure $ u {Scim.roles = [cs $ toByteString $ role]} + userId <- ScimT.scimUserId <$> ScimT.createUser tok scimUser + _ <- ScimT.updateUser tok userId (scimUser {Scim.roles = []}) + ScimT.checkTeamMembersRole tid owner userId RoleMember + mapM_ testUpdateUserWithDefaultRole [minBound .. maxBound] + it "updated user - fail if more than one role given" $ do + (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta + scimUser <- ScimT.randomScimUser + userId <- ScimT.scimUserId <$> ScimT.createUser tok scimUser + ScimT.updateUser' tok userId (scimUser {Scim.roles = ["admin", "member"]}) !!! do + const 400 === statusCode + const (Just "A user cannot have more than one role.") =~= responseBody + it "updated user - fail if role name cannot be parsed correctly" $ do + (tok, _) <- ScimT.registerIdPAndScimTokenWithMeta + scimUser <- ScimT.randomScimUser + userId <- ScimT.scimUserId <$> ScimT.createUser tok scimUser + ScimT.updateUser' tok userId (scimUser {Scim.roles = ["hamlet"]}) !!! do + const 400 === statusCode + const (Just "The role 'hamlet' is not valid. Valid roles are owner, admin, member, partner.") =~= responseBody + specAux :: SpecWith TestEnv specAux = do describe "test helper functions" $ do diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 84bd1dcde5..f8c4af80e9 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -82,7 +82,7 @@ import qualified Web.Scim.Schema.User as Scim.User import qualified Wire.API.Team.Export as CsvExport import qualified Wire.API.Team.Feature as Feature import Wire.API.Team.Invitation (Invitation (..)) -import Wire.API.Team.Role (Role (RoleMember)) +import Wire.API.Team.Role (Role (RoleExternalPartner, RoleMember), defaultRole) import Wire.API.User hiding (scimExternalId) import Wire.API.User.IdentityProvider (IdP) import qualified Wire.API.User.IdentityProvider as User @@ -466,6 +466,8 @@ specCreateUser = describe "POST /Users" $ do context "team has no SAML IdP" $ do it "creates a user with PendingInvitation, and user can follow usual invitation process" $ do testCreateUserNoIdP + it "creates a user with a given role" testCreateUserNoIdPWithRoles + it "fails to create user if roles are invalid" testCreateUserNoIdPInvalidRoles it "fails if no email can be extracted from externalId" $ do testCreateUserNoIdPNoEmail it "doesn't list users that exceed their invitation period, and allows recreating them" $ do @@ -552,6 +554,74 @@ testCreateUserWithPass = do -- TODO: yes, we should just test for error labels consistently, i know... const (Just "Setting user passwords is not supported for security reasons.") =~= responseBody +testCreateUserNoIdPInvalidRoles :: TestSpar () +testCreateUserNoIdPInvalidRoles = do + env <- ask + let brig = env ^. teBrig + let galley = env ^. teGalley + (_, tid) <- call $ createUserWithTeam brig galley + tok <- registerScimToken tid Nothing + email <- randomEmail + scimUserTooManyRoles <- + randomScimUser <&> \u -> + u + { Scim.User.externalId = Just $ fromEmail email, + Scim.User.roles = cs . toByteString <$> [RoleMember, RoleExternalPartner] + } + createUser' tok scimUserTooManyRoles !!! do + const 400 === statusCode + const (Just "A user cannot have more than one role.") =~= responseBody + scimUserInvalidRole <- + randomScimUser <&> \u -> + u + { Scim.User.externalId = Just $ fromEmail email, + Scim.User.roles = ["foobar"] + } + createUser' tok scimUserInvalidRole !!! do + const 400 === statusCode + const (Just "The role 'foobar' is not valid. Valid roles are owner, admin, member, partner.") =~= responseBody + +testCreateUserNoIdPWithRoles :: TestSpar () +testCreateUserNoIdPWithRoles = do + env <- ask + let brig = env ^. teBrig + let galley = env ^. teGalley + (owner, tid) <- call $ createUserWithTeam brig galley + tok <- registerScimToken tid Nothing + forM_ [minBound .. maxBound] (testCreateUserNoIdPWithRole brig tid owner tok) + +testCreateUserNoIdPWithRole :: BrigReq -> TeamId -> UserId -> ScimToken -> Role -> TestSpar () +testCreateUserNoIdPWithRole brig tid owner tok role = do + email <- randomEmail + scimUser <- + randomScimUser <&> \u -> + u + { Scim.User.externalId = Just $ fromEmail email, + Scim.User.roles = [cs $ toByteString role] + } + scimStoredUser <- createUser tok scimUser + let userid = scimUserId scimStoredUser + userName = Name . fromJust . Scim.User.displayName $ scimUser + + do + usr <- Scim.value . Scim.thing <$> getUser tok userid + -- the user hasn't yet followed the invitation flow + -- however the invitee's role is stored together with the invitation in brig and not in spar + -- so as long as the user hasn't accepted the invitation, the scim users's role will be the default role here (which is 'member') + -- FUTUREWORK: if this is not the desired behavior, have to handle this in the `getUser` handler: + -- - if the user has a pending invitation, we have to look up the role in the invitation table + -- by doing an rpc to brig + liftIO $ Scim.User.roles usr `shouldBe` [cs $ toByteString defaultRole] + + -- user follows invitation flow + do + inv <- call $ getInvitation brig email + Just inviteeCode <- call $ getInvitationCode brig tid (inInvitation inv) + registerInvitation email userName inviteeCode True + -- check for correct role + do + checkTeamMembersRole tid owner userid role + testCreateUserNoIdP :: TestSpar () testCreateUserNoIdP = do env <- ask @@ -1111,7 +1181,7 @@ testFindProvisionedUser = do storedUser <- createUser tok user [storedUser'] <- listUsers tok (Just (filterBy "userName" (Scim.User.userName user))) liftIO $ storedUser' `shouldBe` storedUser - liftIO $ Scim.value (Scim.thing storedUser') `shouldBe` normalizeLikeStored (setPreferredLanguage defLang user {Scim.User.emails = [] {- only after validation -}}) + liftIO $ Scim.value (Scim.thing storedUser') `shouldBe` setDefaultRoleIfEmpty (normalizeLikeStored (setPreferredLanguage defLang user {Scim.User.emails = [] {- only after validation -}})) let Just externalId = Scim.User.externalId user users' <- listUsers tok (Just (filterBy "externalId" externalId)) liftIO $ users' `shouldBe` [storedUser] @@ -1435,6 +1505,7 @@ specUpdateUser = describe "PUT /Users/:id" $ do \we want to implement synchronisation from brig to spar?" it "updates to scim user will overwrite these updates" $ pendingWith "that's probably what we want?" + it "updates role" testUpdateUserRole -- | Tests that you can't unset your display name testCannotRemoveDisplayName :: TestSpar () @@ -1514,7 +1585,7 @@ testScimSideIsUpdated = do -- 'updateUser' richInfoLimit <- view (teOpts . to Spar.Types.richInfoLimit) liftIO $ do - Right (Scim.value (Scim.thing storedUser')) `shouldBe` whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user') + Right (Scim.value (Scim.thing storedUser')) `shouldBe` (whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user') <&> setDefaultRoleIfEmpty) Scim.id (Scim.thing storedUser') `shouldBe` Scim.id (Scim.thing storedUser) let meta = Scim.meta storedUser meta' = Scim.meta storedUser' @@ -1570,7 +1641,7 @@ testUpdateSameHandle = do -- Check that the updated user also matches the data that we sent with 'updateUser' richInfoLimit <- view (teOpts . to Spar.Types.richInfoLimit) liftIO $ do - Right (Scim.value (Scim.thing storedUser')) `shouldBe` whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user') + Right (Scim.value (Scim.thing storedUser')) `shouldBe` (whatSparReturnsFor idp richInfoLimit (setPreferredLanguage defLang user') <&> setDefaultRoleIfEmpty) Scim.id (Scim.thing storedUser') `shouldBe` Scim.id (Scim.thing storedUser) let meta = Scim.meta storedUser meta' = Scim.meta storedUser' @@ -1704,6 +1775,37 @@ testBrigSideIsUpdated = do let scimUserWithDefLocale = (validScimUser {Spar.Types._vsuLocale = Spar.Types._vsuLocale validScimUser <|> Just (Locale (Language EN) Nothing)}) brigUser `userShouldMatch` scimUserWithDefLocale +testUpdateUserRole :: TestSpar () +testUpdateUserRole = do + env <- ask + let brig = env ^. teBrig + let galley = env ^. teGalley + (owner, tid) <- call $ createUserWithTeam brig galley + tok <- registerScimToken tid Nothing + forM_ [minBound ..] (forM_ [minBound ..] . testCreateUserWithInitalRoleAndUpdateToTargetRole brig tid owner tok) + where + testCreateUserWithInitalRoleAndUpdateToTargetRole :: BrigReq -> TeamId -> UserId -> ScimToken -> Role -> Role -> TestSpar () + testCreateUserWithInitalRoleAndUpdateToTargetRole brig tid owner tok initialRole targetRole = do + email <- randomEmail + scimUser <- + randomScimUser <&> \u -> + u + { Scim.User.externalId = Just $ fromEmail email, + Scim.User.roles = [cs $ toByteString initialRole] + } + scimStoredUser <- createUser tok scimUser + let userid = scimUserId scimStoredUser + userName = Name . fromJust . Scim.User.displayName $ scimUser + + -- user follows invitation flow + do + inv <- call $ getInvitation brig email + Just inviteeCode <- call $ getInvitationCode brig tid (inInvitation inv) + registerInvitation email userName inviteeCode True + checkTeamMembersRole tid owner userid initialRole + _ <- updateUser tok userid (scimUser {Scim.User.roles = [cs $ toByteString targetRole]}) + checkTeamMembersRole tid owner userid targetRole + ---------------------------------------------------------------------------- -- Patching users specPatchUser :: SpecWith TestEnv diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index 08f72bb750..e958494c5e 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -33,6 +33,7 @@ import qualified Data.Text.Lazy as Lazy import Data.Time import Data.UUID as UUID import Data.UUID.V4 as UUID +import qualified Galley.Types.Teams as Teams import Imports import qualified Network.Wai.Utilities as Error import qualified SAML2.WebSSO as SAML @@ -57,6 +58,8 @@ import qualified Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User as Scim.User import qualified Web.Scim.Schema.User.Email as Email import qualified Web.Scim.Schema.User.Phone as Phone +import qualified Wire.API.Team.Member as Member +import Wire.API.Team.Role (Role, defaultRole) import Wire.API.User import Wire.API.User.IdentityProvider import Wire.API.User.RichInfo @@ -182,6 +185,18 @@ randomScimPhone = do ---------------------------------------------------------------------------- -- API wrappers +createUser' :: + HasCallStack => + ScimToken -> + Scim.User.User SparTag -> + TestSpar ResponseLBS +createUser' tok user = do + env <- ask + createUser_ + (Just tok) + user + (env ^. teSpar) + -- | Create a user. createUser :: HasCallStack => @@ -189,15 +204,19 @@ createUser :: Scim.User.User SparTag -> TestSpar (Scim.StoredUser SparTag) createUser tok user = do - env <- ask - r <- - createUser_ - (Just tok) - user - (env ^. teSpar) - + ScimToken -> + UserId -> + Scim.User.User SparTag -> + TestSpar ResponseLBS +updateUser' tok userid user = do + env <- ask + updateUser_ (Just tok) (Just userid) user (env ^. teSpar) + -- | Update a user. updateUser :: HasCallStack => @@ -206,14 +225,7 @@ updateUser :: Scim.User.User SparTag -> TestSpar (Scim.StoredUser SparTag) updateUser tok userid user = do - env <- ask - r <- - updateUser_ - (Just tok) - (Just userid) - user - (env ^. teSpar) - Scim.User.User SparTag -> Scim.User.User Spa setPreferredLanguage lang u = u {Scim.preferredLanguage = Scim.preferredLanguage u <|> Just (lan2Text lang)} +setDefaultRoleIfEmpty :: Scim.User.User a -> Scim.User.User a +setDefaultRoleIfEmpty u = + u + { Scim.User.roles = case Scim.User.roles u of + [] -> [cs $ toByteString' defaultRole] + xs -> xs + } + -- this is not always correct, but hopefully for the tests that we're using it in it'll do. scimifyBrigUserHack :: User -> Email -> User scimifyBrigUserHack usr email = @@ -687,3 +707,8 @@ getDefaultUserLocale = do . expect2xx ) pure defLocale + +checkTeamMembersRole :: HasCallStack => TeamId -> UserId -> UserId -> Role -> TestSpar () +checkTeamMembersRole tid owner uid role = do + [member] <- filter ((== uid) . (^. Member.userId)) <$> getTeamMembers owner tid + liftIO $ (member ^. Member.permissions . to Teams.permissionsRole) `shouldBe` Just role