[SQSERVICE-253] Support provisioning role information with SCIM

changelog.d/2-features/pr-2851

@@ -0,0 +1 @@
+A team member's role can now be provisioned via SCIM

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
       ]

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

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 =

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)
 

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}.

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

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

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,58 +784,40 @@ 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
   P.debug $
     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
         (TeamSize size) <- E.getSize tid
         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

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 ()

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