[SQSERVICES-253] Support provisioning role information with scim PATCH

changelog.d/2-features/pr-2855

@@ -0,0 +1 @@
+A team member's role can now be provisioned via SCIM (#2851, #2855)

libs/hscim/src/Web/Scim/Schema/User.hs

@@ -315,12 +315,14 @@ applyUserOperation user (Operation Replace (Just (NormalPath (AttrPath _schema a
       (\x -> user {externalId = x}) <$> resultToScimError (fromJSON value)
     "active" ->
       (\x -> user {active = x}) <$> resultToScimError (fromJSON value)
-    _ -> throwError (badRequest InvalidPath (Just "we only support attributes username, displayname, externalid, active"))
+    "roles" ->
+      (\x -> user {roles = x}) <$> resultToScimError (fromJSON value)
+    _ -> throwError (badRequest InvalidPath (Just "we only support attributes username, displayname, externalid, active, roles"))
 applyUserOperation _ (Operation Replace (Just (IntoValuePath _ _)) _) = do
   throwError (badRequest InvalidPath (Just "can not lens into multi-valued attributes yet"))
 applyUserOperation user (Operation Replace Nothing (Just value)) = do
   case value of
-    Object hm | null ((AttrName . Key.toText <$> KeyMap.keys hm) \\ ["username", "displayname", "externalid", "active"]) -> do
+    Object hm | null ((AttrName . Key.toText <$> KeyMap.keys hm) \\ ["username", "displayname", "externalid", "active", "roles"]) -> do
       (u :: User tag) <- resultToScimError $ fromJSON value
       pure $
         user
@@ -329,7 +331,7 @@ applyUserOperation user (Operation Replace Nothing (Just value)) = do
             externalId = externalId u,
             active = active u
           }
-    _ -> throwError (badRequest InvalidPath (Just "we only support attributes username, displayname, externalid, active"))
+    _ -> throwError (badRequest InvalidPath (Just "we only support attributes username, displayname, externalid, active, roles"))
 applyUserOperation _ (Operation Replace _ Nothing) =
   throwError (badRequest InvalidValue (Just "No value was provided"))
 applyUserOperation _ (Operation Remove Nothing _) = throwError (badRequest NoTarget Nothing)
@@ -339,6 +341,7 @@ applyUserOperation user (Operation Remove (Just (NormalPath (AttrPath _schema at
     "displayname" -> pure $ user {displayName = Nothing}
     "externalid" -> pure $ user {externalId = Nothing}
     "active" -> pure $ user {active = Nothing}
+    "roles" -> pure $ user {roles = []}
     _ -> pure user
 applyUserOperation _ (Operation Remove (Just (IntoValuePath _ _)) _) = do
   throwError (badRequest InvalidPath (Just "can not lens into multi-valued attributes yet"))

libs/hscim/test/Test/Schema/UserSpec.hs

@@ -103,7 +103,6 @@ spec = do
           ("photos", toJSON @[Photo] mempty),
           ("addresses", toJSON @[Address] mempty),
           ("entitlements", toJSON @[Text] mempty),
-          ("roles", toJSON @[Text] mempty),
           ("x509Certificates", toJSON @[Certificate] mempty)
         ]
         $ \(key, upd) -> do

services/spar/test-integration/Test/Spar/Scim/UserSpec.hs

@@ -77,6 +77,7 @@ import qualified Web.Scim.Filter as Filter
 import qualified Web.Scim.Schema.Common as Scim
 import qualified Web.Scim.Schema.ListResponse as Scim
 import qualified Web.Scim.Schema.Meta as Scim
+import Web.Scim.Schema.PatchOp (Operation)
 import qualified Web.Scim.Schema.PatchOp as PatchOp
 import qualified Web.Scim.Schema.User as Scim.User
 import qualified Wire.API.Team.Export as CsvExport
@@ -1823,6 +1824,11 @@ specPatchUser = do
             PatchOp.Replace
             (Just (PatchOp.NormalPath (Filter.topLevelAttrPath name)))
             (Just (toJSON value))
+    let addAttrib name value =
+          PatchOp.Operation
+            PatchOp.Add
+            (Just (PatchOp.NormalPath (Filter.topLevelAttrPath name)))
+            (Just (toJSON value))
     let removeAttrib name =
           PatchOp.Operation
             PatchOp.Remove
@@ -1900,6 +1906,8 @@ specPatchUser = do
             [replaceAttrib "externalId" externalId]
       let user'' = Scim.value . Scim.thing $ storedUser'
       liftIO $ Scim.User.externalId user'' `shouldBe` externalId
+    it "replace role works" $ testPatchRole replaceAttrib
+    it "add role works" $ testPatchRole addAttrib
     it "replacing every supported atttribute at once works" $ do
       (tok, _) <- registerIdPAndScimToken
       user <- randomScimUser
@@ -1967,6 +1975,47 @@ specPatchUser = do
       let patchOp = PatchOp.PatchOp [removeAttrib "externalId"]
       patchUser_ (Just tok) (Just userid) patchOp (env ^. teSpar) !!! const 400 === statusCode
 
+testPatchRole :: (Text -> [Role] -> Operation) -> TestSpar ()
+testPatchRole replaceOrAdd = do
+  env <- ask
+  let brig = env ^. teBrig
+  let galley = env ^. teGalley
+  (owner, tid) <- call $ createUserWithTeam brig galley
+  tok <- registerScimToken tid Nothing
+  let testWithInitialRole r = forM_ [minBound .. maxBound] (testPatchRoles brig replaceOrAdd tid owner tok r)
+  forM_ [minBound .. maxBound] testWithInitialRole
+
+testPatchRoles :: BrigReq -> (Text -> [Role] -> Operation) -> TeamId -> UserId -> ScimToken -> Role -> Role -> TestSpar ()
+testPatchRoles brig replaceOrAdd 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
+
+  _ <- patchUser tok userid $ PatchOp.PatchOp [replaceOrAdd "roles" [targetRole]]
+  checkTeamMembersRole tid owner userid targetRole
+  -- also check if remove works
+  let removeAttrib name =
+        PatchOp.Operation
+          PatchOp.Remove
+          (Just (PatchOp.NormalPath (Filter.topLevelAttrPath name)))
+          Nothing
+  _ <- patchUser tok userid $ PatchOp.PatchOp [removeAttrib "roles"]
+  checkTeamMembersRole tid owner userid defaultRole
+
 ----------------------------------------------------------------------------
 -- Deleting users