From b3a7c2ff88a2e718995da9ef19bd2ee166854a37 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 21 Nov 2022 11:43:47 +0000 Subject: [PATCH 1/5] patch works (remove, add, replace) --- libs/hscim/src/Web/Scim/Schema/User.hs | 9 ++-- .../Test/Spar/Scim/UserSpec.hs | 49 +++++++++++++++++++ 2 files changed, 55 insertions(+), 3 deletions(-) diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs index c453309b838..16cac92a880 100644 --- a/libs/hscim/src/Web/Scim/Schema/User.hs +++ b/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")) diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index f8c4af80e90..aa78b49627c 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/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 From 7455f79b41b3706e18b46b32da6e37e65ce8c829 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 21 Nov 2022 14:28:36 +0000 Subject: [PATCH 2/5] changelog --- changelog.d/2-features/pr-2851 | 1 - changelog.d/2-features/pr-2855 | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) delete mode 100644 changelog.d/2-features/pr-2851 create mode 100644 changelog.d/2-features/pr-2855 diff --git a/changelog.d/2-features/pr-2851 b/changelog.d/2-features/pr-2851 deleted file mode 100644 index 3bd9a08c5d1..00000000000 --- a/changelog.d/2-features/pr-2851 +++ /dev/null @@ -1 +0,0 @@ -A team member's role can now be provisioned via SCIM diff --git a/changelog.d/2-features/pr-2855 b/changelog.d/2-features/pr-2855 new file mode 100644 index 00000000000..d85440a5770 --- /dev/null +++ b/changelog.d/2-features/pr-2855 @@ -0,0 +1 @@ +A team member's role can now be provisioned via SCIM (#2851, #2855) From 7074ac8d1af9b5802771ead9d985228932b4c7e4 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 25 Nov 2022 10:42:18 +0000 Subject: [PATCH 3/5] fixed hscim tests --- libs/hscim/test/Test/Schema/UserSpec.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs index 6ebcf1c4ae5..6f7ae9180a6 100644 --- a/libs/hscim/test/Test/Schema/UserSpec.hs +++ b/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 From d70bca8e7fee76b96e868bf1b588b1ce282da45f Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 28 Nov 2022 10:36:48 +0000 Subject: [PATCH 4/5] renaming and also test empty roles --- .../Test/Spar/Scim/UserSpec.hs | 62 +++++++++---------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index aa78b49627c..32a7b803580 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -1982,39 +1982,39 @@ testPatchRole replaceOrAdd = do 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 + let testWithInitialRole r = forM_ (Nothing : fmap Just [minBound ..]) (testCreateUserWithInitialRoleAndPatchToTargetRole brig tid owner tok r) + forM_ [minBound ..] testWithInitialRole + where + testCreateUserWithInitialRoleAndPatchToTargetRole :: BrigReq -> TeamId -> UserId -> ScimToken -> Role -> Maybe Role -> TestSpar () + testCreateUserWithInitialRoleAndPatchToTargetRole brig tid owner tok initialRole mTargetRole = 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 -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 - -- 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 + _ <- patchUser tok userid $ PatchOp.PatchOp [replaceOrAdd "roles" (maybeToList mTargetRole)] + checkTeamMembersRole tid owner userid (fromMaybe defaultRole mTargetRole) + -- 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 From 38cbbeb50946e63724023f7ce0e2d55a8a4ef7a5 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 28 Nov 2022 13:09:00 +0000 Subject: [PATCH 5/5] refactoring and test ivalid input --- .../Test/Spar/Scim/UserSpec.hs | 97 ++++++++++++------- services/spar/test-integration/Util/Scim.hs | 16 ++- 2 files changed, 75 insertions(+), 38 deletions(-) diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 32a7b803580..3429af354b6 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -38,6 +38,7 @@ import Control.Monad.Except (MonadError (throwError)) import Control.Monad.Random (randomRIO) import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe +import qualified Data.Aeson import qualified Data.Aeson as Aeson import Data.Aeson.Lens (key, _String) import Data.Aeson.QQ (aesonQQ) @@ -1773,7 +1774,7 @@ testBrigSideIsUpdated = do _ <- updateUser tok userid user' validScimUser <- either (error . show) pure $ validateScimUser' "testBrigSideIsUpdated" (Just idp) 999999 user' brigUser <- maybe (error "no brig user") pure =<< runSpar (Intra.getBrigUser Intra.WithPendingInvitations userid) - let scimUserWithDefLocale = (validScimUser {Spar.Types._vsuLocale = Spar.Types._vsuLocale validScimUser <|> Just (Locale (Language EN) Nothing)}) + let scimUserWithDefLocale = validScimUser {Spar.Types._vsuLocale = Spar.Types._vsuLocale validScimUser <|> Just (Locale (Language EN) Nothing)} brigUser `userShouldMatch` scimUserWithDefLocale testUpdateUserRole :: TestSpar () @@ -1783,10 +1784,13 @@ testUpdateUserRole = do let galley = env ^. teGalley (owner, tid) <- call $ createUserWithTeam brig galley tok <- registerScimToken tid Nothing - forM_ [minBound ..] (forM_ [minBound ..] . testCreateUserWithInitalRoleAndUpdateToTargetRole brig tid owner tok) + let mTargetRoles = Nothing : map Just [minBound ..] + let testUpdate = testCreateUserWithInitalRoleAndUpdateToTargetRole brig tid owner tok + let testWithTarget = forM_ mTargetRoles . testUpdate + forM_ [minBound ..] testWithTarget where - testCreateUserWithInitalRoleAndUpdateToTargetRole :: BrigReq -> TeamId -> UserId -> ScimToken -> Role -> Role -> TestSpar () - testCreateUserWithInitalRoleAndUpdateToTargetRole brig tid owner tok initialRole targetRole = do + testCreateUserWithInitalRoleAndUpdateToTargetRole :: BrigReq -> TeamId -> UserId -> ScimToken -> Role -> Maybe Role -> TestSpar () + testCreateUserWithInitalRoleAndUpdateToTargetRole brig tid owner tok initialRole mTargetRole = do email <- randomEmail scimUser <- randomScimUser <&> \u -> @@ -1804,8 +1808,8 @@ testUpdateUserRole = do 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 + _ <- updateUser tok userid (scimUser {Scim.User.roles = cs . toByteString <$> maybeToList mTargetRole}) + checkTeamMembersRole tid owner userid (fromMaybe defaultRole mTargetRole) ---------------------------------------------------------------------------- -- Patching users @@ -1908,6 +1912,8 @@ specPatchUser = do liftIO $ Scim.User.externalId user'' `shouldBe` externalId it "replace role works" $ testPatchRole replaceAttrib it "add role works" $ testPatchRole addAttrib + it "replace with invalid input should fail" $ testPatchIvalidInput replaceAttrib + it "add with invalid input should fail" $ testPatchIvalidInput addAttrib it "replacing every supported atttribute at once works" $ do (tok, _) <- registerIdPAndScimToken user <- randomScimUser @@ -1975,6 +1981,27 @@ specPatchUser = do let patchOp = PatchOp.PatchOp [removeAttrib "externalId"] patchUser_ (Just tok) (Just userid) patchOp (env ^. teSpar) !!! const 400 === statusCode +testPatchIvalidInput :: (Text -> [Role] -> Operation) -> TestSpar () +testPatchIvalidInput patchOp = do + env <- ask + let brig = env ^. teBrig + let galley = env ^. teGalley + (owner, tid) <- call $ createUserWithTeam brig galley + tok <- registerScimToken tid Nothing + userId <- createScimUserWithRole brig tid owner tok defaultRole + let patchWithInvalidRole = + PatchOp.Operation + PatchOp.Replace + (Just (PatchOp.NormalPath (Filter.topLevelAttrPath "roles"))) + (Just $ Data.Aeson.Array $ V.singleton $ Data.Aeson.String "invalid-role") + patchUser' tok userId (PatchOp.PatchOp [patchWithInvalidRole]) !!! do + const 400 === statusCode + const (Just "The role 'invalid-role' is not valid. Valid roles are owner, admin, member, partner.") =~= responseBody + let patchWithTooManyRoles = patchOp "roles" [defaultRole, defaultRole] + patchUser' tok userId (PatchOp.PatchOp [patchWithTooManyRoles]) !!! do + const 400 === statusCode + const (Just "A user cannot have more than one role.") =~= responseBody + testPatchRole :: (Text -> [Role] -> Operation) -> TestSpar () testPatchRole replaceOrAdd = do env <- ask @@ -1982,39 +2009,41 @@ testPatchRole replaceOrAdd = do let galley = env ^. teGalley (owner, tid) <- call $ createUserWithTeam brig galley tok <- registerScimToken tid Nothing - let testWithInitialRole r = forM_ (Nothing : fmap Just [minBound ..]) (testCreateUserWithInitialRoleAndPatchToTargetRole brig tid owner tok r) - forM_ [minBound ..] testWithInitialRole + let mTargetRoles = Nothing : fmap Just [minBound ..] + let testPatch = testCreateUserWithInitialRoleAndPatchToTargetRole brig tid owner tok + let testWithTarget = forM mTargetRoles . testPatch + forM_ [minBound ..] testWithTarget where testCreateUserWithInitialRoleAndPatchToTargetRole :: BrigReq -> TeamId -> UserId -> ScimToken -> Role -> Maybe Role -> TestSpar () testCreateUserWithInitialRoleAndPatchToTargetRole brig tid owner tok initialRole mTargetRole = 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 + userId <- createScimUserWithRole brig tid owner tok initialRole + void $ patchUser tok userId $ PatchOp.PatchOp [replaceOrAdd "roles" (maybeToList mTargetRole)] + checkTeamMembersRole tid owner userId (fromMaybe defaultRole mTargetRole) + -- also check if remove works + let removeAttrib name = PatchOp.Operation PatchOp.Remove (Just (PatchOp.NormalPath (Filter.topLevelAttrPath name))) Nothing + void $ patchUser tok userId $ PatchOp.PatchOp [removeAttrib "roles"] + checkTeamMembersRole tid owner userId defaultRole - -- 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 +createScimUserWithRole :: BrigReq -> TeamId -> UserId -> ScimToken -> Role -> TestSpar UserId +createScimUserWithRole brig tid owner tok initialRole = 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 - _ <- patchUser tok userid $ PatchOp.PatchOp [replaceOrAdd "roles" (maybeToList mTargetRole)] - checkTeamMembersRole tid owner userid (fromMaybe defaultRole mTargetRole) - -- 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 + -- 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 + pure userid ---------------------------------------------------------------------------- -- Deleting users diff --git a/services/spar/test-integration/Util/Scim.hs b/services/spar/test-integration/Util/Scim.hs index e958494c5e7..7c4e64c4aed 100644 --- a/services/spar/test-integration/Util/Scim.hs +++ b/services/spar/test-integration/Util/Scim.hs @@ -236,12 +236,20 @@ patchUser :: Scim.PatchOp.PatchOp SparTag -> TestSpar (Scim.StoredUser SparTag) patchUser tok uid patchOp = do - env <- ask - r <- - patchUser_ (Just tok) (Just uid) patchOp (env ^. teSpar) - + ScimToken -> + UserId -> + Scim.PatchOp.PatchOp SparTag -> + TestSpar ResponseLBS +patchUser' tok uid patchOp = do + env <- ask + patchUser_ (Just tok) (Just uid) patchOp (env ^. teSpar) + -- | Delete a user. deleteUser :: HasCallStack =>