WPB-23434: Resolve SCIM PATCH emails review feedback

Handle Add on emails[...] value-path explicitly instead of rewriting to Replace: whole-entry Add appends (concat semantics) while sub-attribute Add delegates to the Replace path. Give ValuePath named record fields and drop the redundant valuePathFilter helper. Correct the create-on-absent NOTE to cite Entra's documented Add behaviour. Move the end-to-end email PATCH test to the new integration suite (patchScimUser helper + testSparPatchEmailValuePath) and remove the deprecated copy. Add hscim unit tests for the Add behaviour.

Author: blackheaven

integration/test/API/Spar.hs

@@ -112,6 +112,20 @@ updateScimUser domain scimToken userId scimUser = do
     & scimCommonHeaders scimToken
     & addJSON body
 
+patchScimUser ::
+  (HasCallStack, MakesValue domain, MakesValue patchOp) =>
+  domain ->
+  String ->
+  String ->
+  patchOp ->
+  App Response
+patchScimUser domain scimToken userId patchOp = do
+  req <- baseRequest domain Spar Versioned $ joinHttpPath ["scim", "v2", "Users", userId]
+  body <- make patchOp
+  submit "PATCH" $ req
+    & scimCommonHeaders scimToken
+    & addJSON body
+
 createScimUserGroup :: (HasCallStack, MakesValue domain, MakesValue scimUserGroup) => domain -> String -> scimUserGroup -> App Response
 createScimUserGroup domain token scimUserGroup = do
   req <- baseRequest domain Spar Versioned "/scim/v2/Groups"

integration/test/Test/Spar.hs

@@ -195,6 +195,57 @@ testSparExternalIdDifferentFromEmailWithIdp = do
       subject <- u %. "sso_id.subject" >>= asString
       subject `shouldContainString` currentExtId
 
+testSparPatchEmailValuePath :: (HasCallStack) => App ()
+testSparPatchEmailValuePath = do
+  (owner, tid, _) <- createTeam OwnDomain 1
+  void $ setTeamFeatureStatus owner tid "sso" "enabled"
+  void $ registerTestIdPWithMeta owner >>= getJSON 201
+  tok <- createScimTokenV6 owner def >>= getJSON 200 >>= (%. "token") >>= asString
+  email <- randomEmail
+  extId <- randomExternalId
+  -- a single work-typed email so the value-path filter matches in place
+  -- (avoids the pickPrimary/pickFirst ambiguity in 'scimEmailsToEmailAddress')
+  scimUser <-
+    randomScimUserWithEmail extId email
+      >>= setField "emails" (toJSON [object ["value" .= email, "type" .= ("work" :: String)]])
+  userId <- createScimUser OwnDomain tok scimUser >>= getJSON 201 >>= (%. "id") >>= asString
+  activateEmail OwnDomain email
+  -- Exercise the real Entra payload end-to-end: Entra sends an 'Add' on
+  -- emails[type eq "work"].value, and this confirms the new value propagates to
+  -- Brig after activation. (The Add-vs-Replace regression guard for the
+  -- whole-entry append semantics lives in the hscim unit test, since a .value
+  -- Add on a matching entry delegates to the in-place update shared with
+  -- Replace.)
+  newEmail <- randomEmail
+  let patchOp =
+        object
+          [ "schemas" .= (["urn:ietf:params:scim:api:messages:2.0:PatchOp" :: String]),
+            "Operations"
+              .= [ object
+                     [ "op" .= ("Add" :: String),
+                       "path" .= ("emails[type eq \"work\"].value" :: String),
+                       "value" .= newEmail
+                     ]
+                 ]
+          ]
+  bindResponse (patchScimUser OwnDomain tok userId patchOp) $ \res -> do
+    res.status `shouldMatchInt` 200
+  -- SCIM side reflects the new value, type unchanged
+  checkSparGetUserAndFindByExtId OwnDomain tok extId userId $ \u -> do
+    (u %. "emails" >>= asList >>= assertOne >>= (%. "value")) `shouldMatch` newEmail
+    (u %. "emails" >>= asList >>= assertOne >>= (%. "type")) `shouldMatch` ("work" :: String)
+  -- before activation, Brig still holds the old email
+  bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
+    res.status `shouldMatchInt` 200
+    u <- res.json & asList >>= assertOne
+    u %. "email" `shouldMatch` email
+  -- after activation the new email propagated to Brig
+  activateEmail OwnDomain newEmail
+  bindResponse (getUsersId OwnDomain [userId]) $ \res -> do
+    res.status `shouldMatchInt` 200
+    u <- res.json & asList >>= assertOne
+    u %. "email" `shouldMatch` newEmail
+
 testSparExternalIdDifferentFromEmail :: (HasCallStack) => App ()
 testSparExternalIdDifferentFromEmail = do
   (owner, tid, _) <- createTeam OwnDomain 1

libs/hscim/src/Web/Scim/Filter.hs

@@ -128,7 +128,10 @@ data Filter
 -- TODO(arianvp): This is a slight simplification at the moment as we
 -- don't support the complete Filter grammar. This should be a
 -- valFilter, not a FILTER.
-data ValuePath = ValuePath AttrPath Filter
+data ValuePath = ValuePath
+  { valuePathAttrPath :: AttrPath,
+    valuePathFilter :: Filter
+  }
   deriving (Eq, Show)
 
 -- | subAttr   = "." ATTRNAME

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

@@ -316,6 +316,16 @@ applyUserOperation ::
   User tag ->
   Operation ->
   m (User tag)
+applyUserOperation user (Operation Add (Just (IntoValuePath vp mSub)) (Just val)) =
+  case vp of
+    ValuePath (AttrPath _ attr _) _
+      | attr == "emails" -> addEmailsValuePath user vp mSub val
+      | otherwise ->
+          throwError
+            ( badRequest
+                InvalidPath
+                (Just "multi-valued PATCH is only supported for 'emails'")
+            )
 applyUserOperation user (Operation Add path value) = applyUserOperation user (Operation Replace path value)
 applyUserOperation user (Operation Replace (Just (NormalPath (AttrPath _schema attr _subAttr))) (Just value)) =
   case attr of
@@ -383,19 +393,17 @@ applyUserOperation user (Operation Remove (Just (IntoValuePath vp _mSub)) _) =
 -- attribute that Spar persists. Other multi-valued attributes
 -- (@phoneNumbers@, @ims@, ...) remain unsupported and still fail as before.
 --
--- NOTE on "create on absent": RFC 7644 §3.5.2.3 says a @Replace@ value-path
--- that matches nothing is a no-op. Entra, however, emits an @Add@ (rewritten to
--- @Replace@ in 'applyUserOperation') against @emails[type eq "work"].value@ to
--- provision the address, expecting the entry to be created if absent. Every
--- mainstream SCIM client/validator expects this create-on-absent behaviour for
--- the email value-path, so we deviate from the RFC here: when the filter is
--- @type eq <s>@ and no entry matches, we append
+-- NOTE on "create on absent": RFC 7644 §3.5.2.3 says a value-path @Replace@
+-- that matches nothing is a no-op. Microsoft Entra ID, however, provisions the
+-- email address with an @Add@ against @emails[type eq "work"].value@ (Entra uses
+-- @Add@ for both insert and update -- see
+-- <https://learn.microsoft.com/en-us/answers/questions/1693075/why-is-entra-id-sending-add-operations-instead-of>),
+-- expecting the entry to be created if absent. Both 'addEmailsValuePath' and the
+-- @Replace@ path therefore route the @.value@ sub-attribute through
+-- 'replaceEmailValue', which deviates from the RFC: when the filter is
+-- @type eq <s>@ and no entry matches, it appends
 -- @Email { typ = Just s, value = newVal, primary = Nothing }@.
 
--- | The 'Filter' embedded in a 'ValuePath'.
-valuePathFilter :: ValuePath -> Filter
-valuePathFilter (ValuePath _ flt) = flt
-
 -- | Textual form of an 'Email' address, for string comparison.
 emailValueText :: Email -> Text
 emailValueText (Email _ addr _) =
@@ -472,6 +480,30 @@ decodeEmails val = case fromJSON val of
   Success (es' :: [Email]) -> pure es'
   _ -> (: []) <$> resultToScimError (fromJSON val)
 
+-- | Handle an @Add@ on an @emails[...]@ value-path.
+--
+-- For the single-valued email sub-attributes (@.value@, @.type@, @.primary@) an
+-- @Add@ coincides with a @Replace@ (RFC 7644 §3.5.2.3): it sets the
+-- sub-attribute and, for @.value@, creates the entry on absent via
+-- 'replaceEmailValue'. For a whole-entry @Add@ (no sub-attribute) the value-path
+-- filter is intentionally ignored and the new entries are /appended/ rather than
+-- overwriting matches -- the concat semantics that distinguish @Add@ from
+-- @Replace@ for multi-valued attributes (where @Replace@ narrows the target set
+-- via the filter).
+addEmailsValuePath ::
+  (MonadError ScimError m) =>
+  User tag ->
+  ValuePath ->
+  Maybe SubAttr ->
+  Value ->
+  m (User tag)
+addEmailsValuePath user vp mSub val =
+  case mSub of
+    Just _ -> replaceEmailsValuePath user vp mSub val
+    Nothing -> do
+      newEmails <- decodeEmails val
+      pure user {emails = emails user <> newEmails}
+
 -- | Handle a @Replace@ on an @emails[...]@ value-path.
 replaceEmailsValuePath ::
   (MonadError ScimError m) =>

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

@@ -229,6 +229,28 @@ spec = do
       result `shouldSatisfy` isRight
       let Right patched = result
       emails patched `shouldBe` [mkEmail "work" "arr@example.com"]
+    it "Add on .value updates an existing matching email" $ do
+      let Right p = emailValuePath
+          operation = Operation Add (Just p) (Just (String "new@example.com"))
+          result = User.applyPatch (mkUser [mkEmail "work" "old@example.com"]) (PatchOp [operation])
+      result `shouldSatisfy` isRight
+      let Right patched = result
+      emails patched `shouldBe` [mkEmail "work" "new@example.com"]
+    it "Add on .value creates a work email when none matches" $ do
+      let Right p = emailValuePath
+          operation = Operation Add (Just p) (Just (String "x@y.com"))
+          result = User.applyPatch (mkUser []) (PatchOp [operation])
+      result `shouldSatisfy` isRight
+      let Right patched = result
+      emails patched `shouldBe` [mkEmail "work" "x@y.com"]
+    it "Add on a whole emails entry appends without overwriting" $ do
+      let Right p = PatchOp.parsePath (User.supportedSchemas @PatchTag) "emails[type eq \"work\"]"
+          newVal = object ["value" .= String "added@example.com", "type" .= String "work"]
+          operation = Operation Add (Just p) (Just newVal)
+          result = User.applyPatch (mkUser [mkEmail "work" "keep@example.com"]) (PatchOp [operation])
+      result `shouldSatisfy` isRight
+      let Right patched = result
+      emails patched `shouldBe` [mkEmail "work" "keep@example.com", mkEmail "work" "added@example.com"]
   describe "JSON serialization" $ do
     it "handles all fields" $ do
       require prop_roundtrip

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

@@ -2089,30 +2089,6 @@ specPatchUser = do
             [replaceAttrib "externalId" externalId]
       let user'' = Scim.value . Scim.thing $ storedUser'
       liftIO $ Scim.User.externalId user'' `shouldBe` externalId
-    it "can update a user's email via the multi-valued 'emails' value-path" $ do
-      (tok, (_, tid, _idp)) <- registerIdPAndScimToken
-      -- Disable email verification so the patched email is activated directly,
-      -- without a separate activation step.
-      setSamlEmailValidation tid Feature.FeatureStatusDisabled
-      newEmail <- randomEmail
-      user <- randomScimUser
-      storedUser <- createUser tok user
-      let userid = scimUserId storedUser
-      let Right p = PatchOp.parsePath userSchemas "emails[type eq \"work\"].value"
-          operation =
-            PatchOp.Operation
-              PatchOp.Replace
-              (Just p)
-              (Just (toJSON (fromEmail newEmail)))
-      _ <- patchUser tok userid (PatchOp.PatchOp [operation])
-      -- the email propagated all the way to Brig and is reflected on a fresh GET
-      eventually $ do
-        storedUser'' <- getUser tok userid
-        liftIO $
-          Scim.Email.scimEmailsToEmailAddress
-            (Scim.User.emails (Scim.value (Scim.thing storedUser'')))
-            `shouldBe` Just newEmail
-        checkEmail userid (Just newEmail)
     it "replace role works" $ testPatchRole replaceAttrib
     it "add role works" $ testPatchRole addAttrib
     it "replace with invalid input should fail" $ testPatchIvalidInput replaceAttrib