From 2f93069bcf21c4708f07c885db080c9d97c4ae8b Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Mon, 22 Dec 2025 16:24:26 +0100
Subject: [PATCH 01/13] [WIP]

---
 libs/hscim/default.nix                     |  10 +-
 libs/hscim/hscim.cabal                     |   7 +-
 libs/hscim/src/Web/Scim/Class/User.hs      |  15 +-
 libs/hscim/src/Web/Scim/Client.hs          |   2 +-
 libs/hscim/src/Web/Scim/Filter.hs          |   9 +
 libs/hscim/src/Web/Scim/Schema/Common.hs   |   2 +-
 libs/hscim/src/Web/Scim/Schema/PatchOp.hs  | 284 ++++++++++++---------
 libs/hscim/src/Web/Scim/Schema/User.hs     |  98 +------
 libs/hscim/test/Test/Class/UserSpec.hs     |   6 +-
 libs/hscim/test/Test/FilterSpec.hs         |  57 +++++
 libs/hscim/test/Test/Schema/PatchOpSpec.hs | 218 ++++++++--------
 libs/hscim/test/Test/Schema/UserSpec.hs    |  69 +----
 libs/wire-api/src/Wire/API/User/Scim.hs    |  42 ---
 13 files changed, 373 insertions(+), 446 deletions(-)

diff --git a/libs/hscim/default.nix b/libs/hscim/default.nix
index d0a64d40d0..f906963c17 100644
--- a/libs/hscim/default.nix
+++ b/libs/hscim/default.nix
@@ -4,6 +4,7 @@
 # dependencies are added or removed.
 { mkDerivation
 , aeson
+, aeson-diff
 , aeson-qq
 , attoparsec
 , attoparsec-aeson
@@ -24,6 +25,7 @@
 , http-types
 , HUnit
 , hw-hspec-hedgehog
+, imports
 , indexed-traversable
 , lens-aeson
 , lib
@@ -32,6 +34,7 @@
 , mmorph
 , mtl
 , network-uri
+, QuickCheck
 , retry
 , scientific
 , servant
@@ -60,6 +63,7 @@ mkDerivation {
   isExecutable = true;
   libraryHaskellDepends = [
     aeson
+    aeson-diff
     aeson-qq
     attoparsec
     attoparsec-aeson
@@ -75,6 +79,7 @@ mkDerivation {
     http-api-data
     http-media
     http-types
+    imports
     list-t
     microlens
     mmorph
@@ -109,7 +114,8 @@ mkDerivation {
   ];
   testHaskellDepends = [
     aeson
-    attoparsec
+    aeson-diff
+    aeson-qq
     base
     bytestring
     email-validate
@@ -120,10 +126,12 @@ mkDerivation {
     http-types
     HUnit
     hw-hspec-hedgehog
+    imports
     indexed-traversable
     lens-aeson
     microlens
     network-uri
+    QuickCheck
     servant
     servant-server
     stm-containers
diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index 73814d4a55..a63e58efb4 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -86,6 +86,7 @@ library
   ghc-options:        -Wall -Wredundant-constraints -Wunused-packages
   build-depends:
       aeson
+    , aeson-diff
     , aeson-qq
     , attoparsec
     , attoparsec-aeson
@@ -101,6 +102,7 @@ library
     , http-api-data
     , http-media
     , http-types
+    , imports
     , list-t
     , microlens
     , mmorph
@@ -210,7 +212,8 @@ test-suite spec
   build-tool-depends: hspec-discover:hspec-discover
   build-depends:
       aeson
-    , attoparsec
+    , aeson-diff
+    , aeson-qq
     , base
     , bytestring
     , email-validate
@@ -222,10 +225,12 @@ test-suite spec
     , http-types
     , HUnit
     , hw-hspec-hedgehog
+    , imports
     , indexed-traversable
     , lens-aeson
     , microlens
     , network-uri
+    , QuickCheck
     , servant
     , servant-server
     , stm-containers
diff --git a/libs/hscim/src/Web/Scim/Class/User.hs b/libs/hscim/src/Web/Scim/Class/User.hs
index 982ad3700e..a54fa0b8ca 100644
--- a/libs/hscim/src/Web/Scim/Class/User.hs
+++ b/libs/hscim/src/Web/Scim/Class/User.hs
@@ -26,7 +26,7 @@ module Web.Scim.Class.User
   )
 where
 
-import Data.Aeson.Types (FromJSON)
+import Data.Aeson.Types (FromJSON, ToJSON)
 import Servant
 import Servant.API.Generic
 import Servant.Server.Generic
@@ -66,8 +66,8 @@ data UserSite tag route = UserSite
     usPatchUser ::
       route
         :- Capture "id" (UserId tag)
-          :> ReqBody '[SCIM] (PatchOp tag)
-          :> Patch '[SCIM] (StoredUser tag),
+          :> ReqBody '[SCIM] PatchOp
+          :> Servant.Patch '[SCIM] (StoredUser tag),
     usDeleteUser ::
       route
         :- Capture "id" (UserId tag)
@@ -135,18 +135,17 @@ class (Monad m, AuthTypes tag, UserTypes tag) => UserDB tag m where
     AuthInfo tag ->
     UserId tag ->
     -- | PATCH payload
-    PatchOp tag ->
+    PatchOp ->
     ScimHandler m (StoredUser tag)
   default patchUser ::
-    (Patchable (UserExtra tag), FromJSON (UserExtra tag)) =>
+    (FromJSON (UserExtra tag), ToJSON (UserExtra tag)) =>
     AuthInfo tag ->
     UserId tag ->
-    -- | PATCH payload
-    PatchOp tag ->
+    PatchOp ->
     ScimHandler m (StoredUser tag)
   patchUser info uid op' = do
     (WithMeta _ (WithId _ (user :: User tag))) <- getUser info uid
-    (newUser :: User tag) <- applyPatch user op'
+    (newUser :: User tag) <- applyPatch op' user
     putUser info uid newUser
 
   -- | Delete a user.
diff --git a/libs/hscim/src/Web/Scim/Client.hs b/libs/hscim/src/Web/Scim/Client.hs
index c80070fb03..eb6d17d62e 100644
--- a/libs/hscim/src/Web/Scim/Client.hs
+++ b/libs/hscim/src/Web/Scim/Client.hs
@@ -148,7 +148,7 @@ patchUser ::
   ClientEnv ->
   Maybe (AuthData tag) ->
   UserId tag ->
-  PatchOp tag ->
+  PatchOp ->
   IO (StoredUser tag)
 patchUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> _)) :<|> (_ :<|> (r :<|> _))) -> r
 
diff --git a/libs/hscim/src/Web/Scim/Filter.hs b/libs/hscim/src/Web/Scim/Filter.hs
index 5862f6a36b..3a1b18d976 100644
--- a/libs/hscim/src/Web/Scim/Filter.hs
+++ b/libs/hscim/src/Web/Scim/Filter.hs
@@ -67,6 +67,7 @@ import Data.String
 import Data.Text (Text, isInfixOf, isPrefixOf, isSuffixOf, pack)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Text.Lazy (toStrict)
+import Imports (todo)
 import Lens.Micro
 import Web.HttpApiData
 import Web.Scim.AttrName
@@ -154,6 +155,8 @@ topLevelAttrPath x = AttrPath Nothing (AttrName x) Nothing
 -- @
 -- is not supported
 
+-- TODO: why is there no declaration here?
+
 ----------------------------------------------------------------------------
 -- Parsing
 
@@ -291,3 +294,9 @@ instance FromHttpApiData Filter where
 
 instance ToHttpApiData Filter where
   toUrlPiece = renderFilter
+
+instance ToJSON AttrPath where
+  toJSON = toJSON . rAttrPath
+
+instance FromJSON AttrPath where
+  parseJSON = todo
diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs
index c0adb84c21..d1d080a15f 100644
--- a/libs/hscim/src/Web/Scim/Schema/Common.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Common.hs
@@ -40,7 +40,7 @@ data WithId id a = WithId
 
 instance (ToJSON id, ToJSON a) => ToJSON (WithId id a) where
   toJSON (WithId i v) = case toJSON v of
-    (Object o) -> Object (KeyMap.insert "id" (toJSON i) o)
+    (Object o) -> Object (KeyMap.insert (Key.fromString "id") (toJSON i) o)
     other -> other
 
 instance (FromJSON id, FromJSON a) => FromJSON (WithId id a) where
diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
index 1ac01c3b16..7924f7021a 100644
--- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
+++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE ViewPatterns #-}
+
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
@@ -17,134 +19,180 @@
 
 module Web.Scim.Schema.PatchOp where
 
-import Control.Applicative
-import Control.Monad (guard)
-import Control.Monad.Except
-import qualified Data.Aeson.Key as Key
-import qualified Data.Aeson.KeyMap as KeyMap
-import Data.Aeson.Types (FromJSON (parseJSON), ToJSON (toJSON), Value (String), object, withObject, withText, (.:), (.:?), (.=))
-import qualified Data.Aeson.Types as Aeson
-import Data.Attoparsec.ByteString (Parser, endOfInput, parseOnly)
+import Control.Monad.Error.Class (MonadError, throwError)
+import Data.Aeson
+import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.:), (.:?), (.=))
+import qualified Data.Aeson.Diff as AD
+import qualified Data.Aeson.KeyMap as AK
+import qualified Data.Aeson.Pointer as AD
+import Data.Aeson.Types (Parser)
 import Data.Bifunctor (first)
 import qualified Data.CaseInsensitive as CI
+import Data.List.NonEmpty
 import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import Web.Scim.AttrName (AttrName (..))
-import Web.Scim.Filter (AttrPath (..), SubAttr (..), ValuePath (..), pAttrPath, pSubAttr, pValuePath, rAttrPath, rSubAttr, rValuePath)
+import qualified Data.Text as T
+import qualified Data.Text as Text
+import Imports
+import Web.Scim.Filter
 import Web.Scim.Schema.Common (lowerKey)
 import Web.Scim.Schema.Error
-import Web.Scim.Schema.Schema (Schema (PatchOp20))
-import Web.Scim.Schema.UserTypes (UserTypes (supportedSchemas))
-
-newtype PatchOp tag = PatchOp
-  {getOperations :: [Operation]}
-  deriving (Eq, Show)
+import Web.Scim.Schema.Schema
 
--- | The 'Path' attribute value is a 'String' containing an attribute path
--- describing the target of the operation.  It is OPTIONAL
--- for 'Op's "add" and "replace", and is REQUIRED for "remove".  See
--- relevant operation sections below for details.
+-- This type provides the parser for the scim patch syntax, and can be
+-- turned into an `AD.Patch` with `validatePatchOp`.
+--
+-- Differences to AD.Patch:
+-- - Only add, remove, replace.
+-- - Point into array with filters, not indices.
+-- - Case insensitive.
+-- - The semantics is a bit convoluted and may diverge from that of
+--   `AD.Patch` (see RFCs).
 --
--- TODO(arianvp):  When value is an array, it needs special handling.
--- e.g. primary fields need to be negated and whatnot.
--- We currently do not do that :)
+-- Example:
 --
--- NOTE: When the path contains a schema, this schema must be implicitly added
--- to the list of schemas on the result type
-data Operation = Operation
-  { op :: Op,
-    path :: Maybe Path,
-    value :: Maybe Value
-  }
+--    { "schemas":
+--        ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+--      "Operations":[
+--        {
+--         "op":"add",
+--         "path":"members",
+--         "value":[
+--          {
+--            "display": "Babs Jensen",
+--            "$ref": "https://example.com/v2/Users/2819c223...413861904646",
+--            "value": "2819c223-7f76-453a-919d-413861904646"
+--          }
+--         ]
+--        },
+--        ... + additional operations if needed ...
+--      ]
+--    }
+--
+-- patch for scim: https://datatracker.ietf.org/doc/html/rfc7644#section-3.5.2
+-- patch for json: https://datatracker.ietf.org/doc/html/rfc6901
+newtype Patch = Patch {fromPatch :: [PatchOp]}
   deriving (Eq, Show)
 
-data Op
-  = Add
-  | Replace
-  | Remove
-  deriving (Eq, Show, Enum, Bounded)
-
--- | PATH = attrPath / valuePath [subAttr]
-data Path
-  = NormalPath AttrPath
-  | IntoValuePath ValuePath (Maybe SubAttr)
+data PatchOp
+  = PatchOpAdd (Maybe AttrPath) Value
+  | PatchOpRemove AttrPath
+  | PatchOpReplace (Maybe AttrPath) Value
   deriving (Eq, Show)
 
-parsePath :: [Schema] -> Text -> Either String Path
-parsePath schemas' = parseOnly (pPath schemas' <* endOfInput) . encodeUtf8
-
--- | PATH = attrPath / valuePath [subAttr]
-pPath :: [Schema] -> Parser Path
-pPath schemas' =
-  IntoValuePath <$> pValuePath schemas' <*> optional pSubAttr
-    <|> NormalPath <$> pAttrPath schemas'
-
-rPath :: Path -> Text
-rPath (NormalPath attrPath) = rAttrPath attrPath
-rPath (IntoValuePath valuePath subAttr) = rValuePath valuePath <> maybe "" rSubAttr subAttr
-
--- TODO(arianvp): According to the SCIM spec we should throw an InvalidPath
--- error when the path is invalid syntax. this is a bit hard to do though as we
--- can't control what errors FromJSON throws :/
-instance (UserTypes tag) => FromJSON (PatchOp tag) where
-  parseJSON = withObject "PatchOp" $ \v -> do
-    let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v
-    schemas' :: [Schema] <- o .: "schemas"
-    guard $ PatchOp20 `elem` schemas'
-    operations <- Aeson.explicitParseField (Aeson.listParser $ operationFromJSON (supportedSchemas @tag)) o "operations"
-    pure $ PatchOp operations
-
-instance ToJSON (PatchOp tag) where
-  toJSON (PatchOp operations) =
-    object ["operations" .= operations, "schemas" .= [PatchOp20]]
-
--- TODO: Azure wants us to be case-insensitive on _values_ as well here.  We currently do not
--- comply with that.
-operationFromJSON :: [Schema] -> Value -> Aeson.Parser Operation
-operationFromJSON schemas' =
-  withObject "Operation" $ \v -> do
-    let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v
-    Operation
-      <$> (o .: "op")
-      <*> Aeson.explicitParseFieldMaybe (pathFromJSON schemas') o "path"
-      <*> (o .:? "value")
-
-pathFromJSON :: [Schema] -> Value -> Aeson.Parser Path
-pathFromJSON schemas' =
-  withText "Path" $ either fail pure . parsePath schemas'
-
-instance ToJSON Operation where
-  toJSON (Operation op' path' value') =
-    object $ ("op" .= op') : optionalField "path" path' ++ optionalField "value" value'
+----------------------------------------------------------------------
+
+instance ToJSON Patch where
+  toJSON = todo
+
+instance ToJSON PatchOp where
+  toJSON op =
+    object $
+      ["op" .= String (patchOpName op)]
+        <> ["path" .= p | p <- maybeToList $ patchOpPath op]
+        <> ["val" .= v | v <- maybeToList $ patchOpVal op]
     where
-      optionalField fname = \case
-        Nothing -> []
-        Just x -> [fname .= x]
-
-instance FromJSON Op where
-  parseJSON = withText "Op" $ \op' ->
-    case CI.foldCase op' of
-      "add" -> pure Add
-      "replace" -> pure Replace
-      "remove" -> pure Remove
-      _ -> fail "unknown operation"
-
-instance ToJSON Op where
-  toJSON Add = String "add"
-  toJSON Replace = String "replace"
-  toJSON Remove = String "remove"
-
-instance ToJSON Path where
-  toJSON = String . rPath
-
--- | A very coarse description of what it means to be 'Patchable'
--- I do not like it. We should handhold people using this library more
-class Patchable a where
-  applyOperation :: (MonadError ScimError m) => a -> Operation -> m a
-
-instance Patchable (KeyMap.KeyMap Text) where
-  applyOperation theMap (Operation Remove (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) _) =
-    pure $ KeyMap.delete (Key.fromText attrName) theMap
-  applyOperation theMap (Operation _AddOrReplace (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) (Just (String val))) =
-    pure $ KeyMap.insert (Key.fromText attrName) val theMap
-  applyOperation _ _ = throwError $ badRequest InvalidValue $ Just "Unsupported operation"
+      patchOpName :: PatchOp -> Text
+      patchOpName = \case
+        PatchOpAdd _ _ -> "add"
+        PatchOpRemove _ -> "remove"
+        PatchOpReplace _ _ -> "replace"
+
+      patchOpPath :: PatchOp -> Maybe AttrPath
+      patchOpPath = \case
+        PatchOpAdd mbp _ -> mbp
+        PatchOpRemove p -> Just $ p
+        PatchOpReplace mbp _ -> mbp
+
+      patchOpVal :: PatchOp -> Maybe Value
+      patchOpVal = \case
+        PatchOpAdd _ v -> Just v
+        PatchOpRemove _ -> Nothing
+        PatchOpReplace _ v -> Just v
+
+----------------------------------------------------------------------
+
+instance FromJSON Patch where
+  parseJSON = todo
+
+instance FromJSON PatchOp where
+  parseJSON = withObject "PatchOp" $ \o -> do
+    o .: "op" >>= \case
+      "add" -> do
+        path <- o .:? "path"
+        val <- o .: "value"
+        pure $ PatchOpAdd path val
+      "remove" -> do
+        path <- o .: "path"
+        pure $ PatchOpRemove path
+      "replace" -> do
+        path <- o .:? "path"
+        val <- o .: "value"
+        pure $ PatchOpReplace path val
+      unknownOp -> fail $ "Unknown operation: " ++ T.unpack unknownOp
+
+{-
+
+-- TODO: full SCIM path with filter expressions
+scimPathToPointer :: Text -> AD.Pointer
+scimPathToPointer = undefined -- path = map AD.OKey $ T.split (== '.') $ T.dropWhile (== '/') path
+
+pointerToScimPath :: AD.Pointer -> Text
+pointerToScimPath keys =
+  {-
+  T.intercalate "." $ map keyToText keys
+  where
+    keyToText (AD.OKey k) = k
+    keyToText (AD.AKey i) = T.pack (show i)
+  -}
+  undefined
+
+-}
+
+----------------------------------------------------------------------
+
+-- TODO: use this to apply a list of patches so we only have to call AD.patch once.
+applyPatch :: forall m a. (FromJSON a, ToJSON a, MonadError ScimError m) => PatchOp -> a -> m a
+applyPatch = todo
+
+{-
+
+applyPatch hscimOp (toJSON -> jsonOrig) = do
+  patch <-
+    validatePatchOp hscimOp
+      & let err = throwError . badRequest InvalidSyntax . Just . Text.pack
+         in either err pure
+  jsonPatched <-
+    AD.patch patch jsonOrig
+      & let err = throwError . badRequest InvalidValue . Just . ("could not apply patch: " <>) . Text.pack
+         in \case
+              Success val -> pure val
+              Error txt -> err txt
+  fromJSON jsonPatched
+    & let err = throwError . badRequest InvalidPath . Just . ("could not apply patch: " <>) . Text.pack
+       in \case
+            Success val -> pure val
+            Error txt -> err txt
+
+validatePatchOp :: forall m. (MonadError String m) => PatchOp -> Value -> m AD.Patch
+validatePatchOp (PatchOp _) = do
+  -- opOk `mapM_` undefined
+  pure undefined
+  where
+    opOk :: AD.Operation -> m ()
+    opOk = \case
+      AD.Add path _ -> pathOk path
+      AD.Rem path -> pathOk path
+      AD.Rep path _ -> pathOk path
+      AD.Mov {} -> throwError "unsupported patch operation: mov"
+      AD.Cpy {} -> throwError "unsupported patch operation: cpy"
+      AD.Tst {} -> throwError "unsupported patch operation: tst"
+
+    pathOk :: AD.Pointer -> m ()
+    pathOk (AD.Pointer path) = keyOk `mapM_` path
+
+    keyOk :: AD.Key -> m ()
+    keyOk = \case
+      AD.OKey {} -> pure ()
+      AD.AKey {} -> throwError "unsupported key type: index" -- TODO: make this work!
+
+-}
diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs
index 1a37f6dae6..160f6e4129 100644
--- a/libs/hscim/src/Web/Scim/Schema/User.hs
+++ b/libs/hscim/src/Web/Scim/Schema/User.hs
@@ -64,29 +64,21 @@ module Web.Scim.Schema.User
   ( User (..),
     empty,
     NoUserExtra (..),
-    applyPatch,
     resultToScimError,
     isUserSchema,
     module Web.Scim.Schema.UserTypes,
   )
 where
 
-import Control.Monad
 import Control.Monad.Except
 import Data.Aeson
-import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KeyMap
-import Data.List ((\\))
 import Data.Text (Text, pack)
-import qualified Data.Text as Text
 import GHC.Generics (Generic)
 import Lens.Micro
-import Web.Scim.AttrName
-import Web.Scim.Filter (AttrPath (..))
 import Web.Scim.Schema.Common
 import Web.Scim.Schema.Error
-import Web.Scim.Schema.PatchOp
-import Web.Scim.Schema.Schema (Schema (..), getSchemaUri)
+import Web.Scim.Schema.Schema (Schema (..))
 import Web.Scim.Schema.User.Address (Address)
 import Web.Scim.Schema.User.Certificate (Certificate)
 import Web.Scim.Schema.User.Email (Email)
@@ -262,101 +254,13 @@ instance FromJSON NoUserExtra where
 instance ToJSON NoUserExtra where
   toJSON _ = object []
 
-instance Patchable NoUserExtra where
-  applyOperation _ _ = throwError $ badRequest InvalidValue (Just "there are no user extra attributes to patch")
-
 ----------------------------------------------------------------------------
 -- Applying
 
--- | Applies a JSON Patch to a SCIM Core User
--- Only supports the core attributes.
--- Evenmore, only some hand-picked ones currently.
--- We'll have to think how patch is going to work in the presence of extensions.
--- Also, we can probably make  PatchOp type-safe to some extent (Read arianvp's thesis :))
-applyPatch ::
-  ( Patchable (UserExtra tag),
-    FromJSON (UserExtra tag),
-    MonadError ScimError m,
-    UserTypes tag
-  ) =>
-  User tag ->
-  PatchOp tag ->
-  m (User tag)
-applyPatch = (. getOperations) . foldM applyOperation
-
 resultToScimError :: (MonadError ScimError m) => Result a -> m a
 resultToScimError (Error reason) = throwError $ badRequest InvalidValue (Just (pack reason))
 resultToScimError (Success a) = pure a
 
--- TODO(arianvp): support multi-valued and complex attributes.
--- TODO(arianvp): Actually do this in some kind of type-safe way. e.g.
--- have a UserPatch type.
---
--- What I understand from the spec:  The difference between add an replace is only
--- in the fact that replace will not concat multi-values, and behaves differently for complex values too.
--- For simple attributes, add and replace are identical.
-applyUserOperation ::
-  forall m tag.
-  ( UserTypes tag,
-    FromJSON (User tag),
-    Patchable (UserExtra tag),
-    MonadError ScimError m
-  ) =>
-  User tag ->
-  Operation ->
-  m (User tag)
-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
-    "username" ->
-      (\x -> user {userName = x}) <$> resultToScimError (fromJSON value)
-    "displayname" ->
-      (\x -> user {displayName = x}) <$> resultToScimError (fromJSON value)
-    "externalid" ->
-      (\x -> user {externalId = x}) <$> resultToScimError (fromJSON value)
-    "active" ->
-      (\x -> user {active = x}) <$> resultToScimError (fromJSON value)
-    "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", "roles"]) -> do
-      (u :: User tag) <- resultToScimError $ fromJSON value
-      pure $
-        user
-          { userName = userName u,
-            displayName = displayName u,
-            externalId = externalId u,
-            active = active u
-          }
-    _ -> 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)
-applyUserOperation user (Operation Remove (Just (NormalPath (AttrPath _schema attr _subAttr))) _value) =
-  case attr of
-    "username" -> throwError (badRequest Mutability Nothing)
-    "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"))
-
-instance (UserTypes tag, FromJSON (User tag), Patchable (UserExtra tag)) => Patchable (User tag) where
-  applyOperation user op@(Operation _ (Just (NormalPath (AttrPath schema _ _))) _)
-    | isUserSchema schema = applyUserOperation user op
-    | isSupportedCustomSchema schema = (\x -> user {extra = x}) <$> applyOperation (extra user) op
-    | otherwise =
-        throwError $ badRequest InvalidPath $ Just $ "we only support these schemas: " <> Text.intercalate ", " (map getSchemaUri (supportedSchemas @tag))
-    where
-      isSupportedCustomSchema = maybe False (`elem` supportedSchemas @tag)
-  applyOperation user op = applyUserOperation user op
-
 -- Omission of a schema for users is implicitly the core schema
 -- TODO(arianvp): Link to part of the spec that claims this.
 isUserSchema :: Maybe Schema -> Bool
diff --git a/libs/hscim/test/Test/Class/UserSpec.hs b/libs/hscim/test/Test/Class/UserSpec.hs
index 6a46738dcc..de3f77a37a 100644
--- a/libs/hscim/test/Test/Class/UserSpec.hs
+++ b/libs/hscim/test/Test/Class/UserSpec.hs
@@ -363,9 +363,9 @@ spec = with app $ do
         patch
           "/0"
           [scim|{
-          "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-          "Operations": [{ "op": "Remove", "path": "displayName"}]
-        }|]
+            "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+            "operations": [{ "op": "remove", "path": "displayName"}]
+          }|]
           `shouldRespondWith` [scim|{
           "schemas": [
             "urn:ietf:params:scim:schemas:core:2.0:User"
diff --git a/libs/hscim/test/Test/FilterSpec.hs b/libs/hscim/test/Test/FilterSpec.hs
index 9fc6588e7f..d436fbc28d 100644
--- a/libs/hscim/test/Test/FilterSpec.hs
+++ b/libs/hscim/test/Test/FilterSpec.hs
@@ -42,6 +42,63 @@ spec = do
   describe "Filter" $ do
     it "parse . render === id" $ require $ prop_roundtrip @(TestTag Text () () NoUserExtra)
 
+    describe "golden tests" $ do
+      {-
+      describe "attribute paths" $ do
+        let examples :: [(String, Either String Path)]
+            examples =
+              [ ( "members",
+                  Right $ Path $ PathSegField "members" NE.:| []
+                ),
+                ( "name.familyname",
+                  Right $ Path $ PathSegField "name" NE.:| [PathSegField "familyname"]
+                ),
+                ( "addresses[type eq \"work\"]",
+                  Right $ Path $ PathSegField "addresses" NE.:| [readFilter "type eq \"work\""]
+                ),
+                ( "members[value eq \"2819c223-7f76-453a-919d-413861904646\"]",
+                  Right $ Path $ PathSegField "members" NE.:| [readFilter "value eq \"2819c223-7f76-453a-919d-413861904646\""]
+                ),
+                ( "members[type eq \"work\"].displayname",
+                  Right $ Path $ PathSegField "members" NE.:| [readFilter "type eq \"work\"", PathSegField "displayName"]
+                ),
+                ( "members[type lq \"work\" and value eq \"\"]".displayname,
+                  Right $ Path $ PathSegField "members" NE.:| [readFilter "members[type lq \"work\" and value eq \"\"]", PathSegField "displayName"]
+                ),
+                -- weird stuff
+                ( "",
+                  Left ""
+                ),
+                ( ".members",
+                  Left ""
+                ),
+                ( "urn:ietf:params:scim:schemas:core:2.0:Group:.nosuchfield",
+                  Left ""
+                ),
+                ( "urn:ietf:params:scim:schemas:core:2.0:Group:.members",
+                  Left "this should actually work, no?"
+                )
+              ]
+
+            readFilter :: Text -> PathSeg
+            readFilter = either (error "impossible") PathSegArrayFilter . parseFilter []
+
+         for_ examples $ \(ex, want) -> it ex $ eitherDecode @Path (encode ex) `shouldBe` want
+      -}
+
+      describe "filter" $ do
+        -- TODO: enforce schema User20 and Group20, for now)
+
+        it "1" $ do
+          parseFilter [User20] ""
+            `shouldBe` Left ""
+        it "2" $ do
+          parseFilter [] "nosuchfield co \"yessuchfield\""
+            `shouldBe` Right (FilterAttrCompare (AttrPath Nothing "nosuchfield" Nothing) OpCo (ValString "yessuchfield"))
+        it "3" $ do
+          parseFilter [] ".nosuchfield eq "
+            `shouldBe` Right (FilterAttrCompare (AttrPath Nothing "nosuchfield" Nothing) OpCo ValNull)
+
 ----------------------------------------------------------------------------
 -- Generators
 
diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
index 2e9a041531..c92f502b41 100644
--- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs
+++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -20,123 +22,121 @@
 
 module Test.Schema.PatchOpSpec where
 
-import qualified Data.Aeson as Aeson
+import Data.Aeson
+import qualified Data.Aeson.Diff as AD
 import qualified Data.Aeson.KeyMap as KeyMap
-import Data.Aeson.Types (Result (Error, Success), Value (String), fromJSON, toJSON)
-import qualified Data.Aeson.Types as Aeson
-import Data.Attoparsec.ByteString (parseOnly)
-import Data.Either (isLeft)
-import Data.Foldable (for_)
-import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-import HaskellWorks.Hspec.Hedgehog (require)
-import Hedgehog (Gen, Property, forAll, property, tripping)
-import qualified Hedgehog.Gen as Gen
-import qualified Hedgehog.Range as Range
-import Test.FilterSpec (genAttrPath, genSubAttr, genValuePath)
-import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy, xit)
-import Test.Schema.Util (mk_prop_caseInsensitive)
-import Web.Scim.AttrName (AttrName (..))
-import Web.Scim.Filter (AttrPath (..), CompValue (ValNull), CompareOp (OpEq), Filter (..), ValuePath (..))
+import qualified Data.Aeson.Pointer as AD
+import Data.Aeson.QQ (aesonQQ)
+import Data.Aeson.Types
+import Data.Either
+import qualified Data.List.NonEmpty as NE
+import Imports
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+import Web.Scim.Filter
 import Web.Scim.Schema.PatchOp
-import Web.Scim.Schema.Schema (Schema (User20))
-import Web.Scim.Schema.User (UserTypes)
-import Web.Scim.Schema.UserTypes (supportedSchemas)
-import Web.Scim.Test.Util (TestTag, scim)
+import Web.Scim.Schema.User
+import Web.Scim.Test.Util
 
-isSuccess :: Result a -> Bool
-isSuccess (Success _) = True
-isSuccess (Error _) = False
+type PatchTag = TestTag Text () () UserExtraPatch
 
-genPatchOp :: forall tag. (UserTypes tag) => Gen Value -> Gen (PatchOp tag)
-genPatchOp genValue = PatchOp <$> Gen.list (Range.constant 0 20) ((genOperation @tag) genValue)
+type UserExtraPatch = KeyMap.KeyMap Text
 
-genSimplePatchOp :: forall tag. (UserTypes tag) => Gen (PatchOp tag)
-genSimplePatchOp = genPatchOp @tag (String <$> Gen.text (Range.constant 0 20) Gen.unicode)
+spec :: Spec
+spec = do
+  describe "PatchOp" $ do
+    ----------------------------------------------------------------------
 
-genOperation :: forall tag. (UserTypes tag) => Gen Value -> Gen Operation
-genOperation genValue = Operation <$> Gen.enumBounded <*> Gen.maybe (genPath @tag) <*> Gen.maybe genValue
+    it "golden + simple roundtrip" $ do
+      let check :: (PatchOp, Value) -> Expectation
+          check (hs, js) = do
+            toJSON hs `shouldBe` js
+            case parseEither parseJSON js of
+              Left err -> expectationFailure $ "Failed to parse: " ++ err
+              Right (have :: PatchOp) -> have `shouldBe` hs
 
-genPath :: forall tag. (UserTypes tag) => Gen Path
-genPath =
-  Gen.choice
-    [ IntoValuePath <$> (genValuePath @tag) <*> Gen.maybe genSubAttr,
-      NormalPath <$> (genAttrPath @tag)
-    ]
+      check
+        `mapM_` [ ( todo, -- PatchOp (AD.Patch []),
+                    [aesonQQ|
+                    {
+                    "schemaS": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                      "OperaTions": [{
+                        "oP": "aDD",
+                        "pATh": "userName",
+                        "vaLUE": "testuser"
+                      }]
+                    }
+                    |]
+                  )
+                ]
 
-prop_roundtrip :: forall tag. (UserTypes tag) => Property
-prop_roundtrip = property $ do
-  x <- forAll $ genPath @tag
-  tripping x (encodeUtf8 . rPath) (parseOnly $ pPath (supportedSchemas @tag))
+    -- todo "test missing path field for add, rep"
 
-prop_roundtrip_PatchOp :: forall tag. (UserTypes tag) => Property
-prop_roundtrip_PatchOp = property $ do
-  -- Just some strings for now. However, should be constrained to what the
-  -- PatchOp is operating on in the future... We need better typed PatchOp for
-  -- this. TODO(arianvp)
-  x <- forAll (genSimplePatchOp @tag)
-  tripping x toJSON fromJSON
+    it "Operation attributes and value attributes are case-insensitive" $ do
+      let patches :: [Value] =
+            [ [aesonQQ|
+              {
+                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                "Operations": [{
+                  "op": "replace",
+                  "path": "displayName",
+                  "value": "Name"
+                }]
+              }
+              |],
+              [aesonQQ|
+              {
+                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                "Operations": [{
+                  "op": "REPLACE",
+                  "path": "displayName",
+                  "value": "Name"
+                }]
+              }
+              |],
+              [aesonQQ|
+              {
+                "Schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                "Operations": [{
+                  "OP": "Replace",
+                  "PATH": "dISPlayName",
+                  "VALUE": "Name"
+                }]
+              }
+              |]
+            ]
+      case nub $ (eitherDecode @PatchOp . encode) <$> patches of
+        [Right _] -> pure ()
+        bad -> expectationFailure $ "Case insensitivity check failed, the following variantions should not be distinguished: " ++ show bad
 
-type PatchTestTag = TestTag () () () ()
+  describe "applyPatch" $ do
+    prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
+      \(barbie :: User (TestTag Text () () NoUserExtra)) changedWant ->
+        let patchOp = todo -- PatchOp (AD.diff (toJSON barbie) (toJSON changedWant))
+         in applyPatch patchOp barbie === Right changedWant
 
-spec :: Spec
-spec = do
-  describe "Patchable" $
-    describe "HashMap Text Text" $ do
-      it "supports `Add` operation" $ do
-        let theMap = KeyMap.empty @Text
-            operation = Operation Add (Just $ NormalPath (AttrPath Nothing (AttrName "key") Nothing)) $ Just "value"
-        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key" "value")
-      it "supports `Replace` operation" $ do
-        let theMap = KeyMap.singleton @Text "key" "value1"
-            operation = Operation Replace (Just $ NormalPath (AttrPath Nothing (AttrName "key") Nothing)) $ Just "value2"
-        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key" "value2")
-      it "supports `Delete` operation" $ do
-        let theMap = KeyMap.fromList @Text [("key1", "value1"), ("key2", "value2")]
-            operation = Operation Remove (Just $ NormalPath (AttrPath Nothing (AttrName "key1") Nothing)) Nothing
-        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key2" "value2")
-      it "gracefully rejects invalid/unsupported operations" $ do
-        let theMap = KeyMap.fromList @Text [("key1", "value1"), ("key2", "value2")]
-            key1Path = AttrPath Nothing (AttrName "key1") Nothing
-            key2Path = AttrPath Nothing (AttrName "key2") Nothing
-            invalidOperations =
-              [ Operation Add (Just $ NormalPath key1Path) Nothing, -- Nothing to add
-                Operation Replace (Just $ NormalPath key1Path) Nothing, -- Nothing to replace
-                Operation Add (Just $ IntoValuePath (ValuePath key1Path (FilterAttrCompare key2Path OpEq ValNull)) Nothing) Nothing
-                -- IntoValuePaths don't make sense for HashMap Text Text
-              ]
-        mapM_ (\o -> applyOperation theMap o `shouldSatisfy` isLeft) invalidOperations
-  describe "urn:ietf:params:scim:api:messages:2.0:PatchOp" $ do
-    describe "The body of each request MUST contain the \"schemas\" attribute with the URI value of \"urn:ietf:params:scim:api:messages:2.0:PatchOp\"." $
-      it "rejects an empty schemas list" $ do
-        fromJSON @(PatchOp PatchTestTag)
-          [scim| {
-          "schemas": [],
-          "operations": []
-        }|]
-          `shouldSatisfy` (not . isSuccess)
-    -- TODO(arianvp): We don't support arbitrary path names (yet)
-    it "roundtrips Path" $ require $ prop_roundtrip @PatchTestTag
-    it "roundtrips PatchOp" $ require $ prop_roundtrip_PatchOp @PatchTestTag
-    it "case-insensitive" $ require $ mk_prop_caseInsensitive (genSimplePatchOp @PatchTestTag)
-    it "rejects invalid operations" $
-      fromJSON @(PatchOp PatchTestTag)
-        [scim| {
-          "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-          "operations": [{"op":"unknown"}]
-      }|]
-        `shouldSatisfy` (not . isSuccess)
-    -- TODO(arianvp/akshay): Implement if required
-    xit "rejects unknown paths" $
-      Aeson.parse (pathFromJSON [User20]) (Aeson.String "unknown.field") `shouldSatisfy` (not . isSuccess)
-    it "rejects invalid paths" $
-      Aeson.parse (pathFromJSON [User20]) "unknown]field" `shouldSatisfy` (not . isSuccess)
-    describe "Examples from https://tools.ietf.org/html/rfc7644#section-3.5.2 Figure 8" $ do
-      let examples =
-            [ "members",
-              "name.familyname",
-              "addresses[type eq \"work\"]",
-              "members[value eq \"2819c223-7f76-453a-919d-413861904646\"]",
-              "members[value eq \"2819c223-7f76-453a-919d-413861904646\"].displayname"
-            ]
-      for_ examples $ \p -> it ("parses " ++ show p) $ rPath <$> parseOnly (pPath (supportedSchemas @PatchTestTag)) p `shouldBe` Right (decodeUtf8 p)
+    it "throws expected error when patched object doesn't parse" $ do
+      () <- todo
+      True `shouldBe` False
+
+    it "discards all paths that don't match the user/group schema" $ do
+      _ <- todo
+      True `shouldBe` False
+
+    it "Throws error when trying to update immutable / readOnly values" $ do
+      -- https://datatracker.ietf.org/doc/html/rfc7644#section-3.5.2
+      _ <- todo
+      True `shouldBe` False
+
+instance Arbitrary (User (TestTag Text () () NoUserExtra)) where
+  -- TODO: move this to test module in library.
+  arbitrary =
+    {-  do
+      userName <- undefined -- Gen.text (Range.constant 1 20) Gen.unicode
+      externalId <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
+      displayName <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
+      active <- undefined -- Gen.maybe $ ScimBool <$> Gen.bool
+      pure (empty [User20] userName NoUserExtra) {externalId = externalId}
+     -}
+    undefined
diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs
index 1885060fac..e27f0eabe6 100644
--- a/libs/hscim/test/Test/Schema/UserSpec.hs
+++ b/libs/hscim/test/Test/Schema/UserSpec.hs
@@ -27,8 +27,6 @@ where
 
 import Data.Aeson
 import qualified Data.Aeson.KeyMap as KeyMap
-import Data.Either (isLeft, isRight)
-import Data.Foldable (for_)
 import Data.Text (Text)
 import HaskellWorks.Hspec.Hedgehog (require)
 import Hedgehog
@@ -40,12 +38,9 @@ import Test.Hspec
 import Test.Schema.Util (genUri, mk_prop_caseInsensitive)
 import Text.Email.Validate (emailAddress, validate)
 import qualified Web.Scim.Class.User as UserClass
-import Web.Scim.Filter (AttrPath (..))
 import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..), WithId (..), lowerKey)
 import qualified Web.Scim.Schema.ListResponse as ListResponse
 import Web.Scim.Schema.Meta (ETag (Strong, Weak), Meta (..), WithMeta (..))
-import Web.Scim.Schema.PatchOp (Op (..), Operation (..), PatchOp (..), Patchable (..), Path (..))
-import qualified Web.Scim.Schema.PatchOp as PatchOp
 import Web.Scim.Schema.Schema (Schema (..))
 import Web.Scim.Schema.User (NoUserExtra (..), User (..))
 import qualified Web.Scim.Schema.User as User
@@ -63,10 +58,6 @@ prop_roundtrip = property $ do
   user <- forAll genUser
   tripping user toJSON fromJSON
 
-type PatchTag = TestTag Text () () UserExtraPatch
-
-type UserExtraPatch = KeyMap.KeyMap Text
-
 spec :: Spec
 spec = do
   describe "scimEmailsToEmailAddress" $ do
@@ -101,55 +92,6 @@ spec = do
         ]
         `shouldBe` Just adr1
 
-  describe "applyPatch" $ do
-    it "only applies patch for supported fields" $ do
-      let schemas' = []
-      let extras = KeyMap.empty
-      let user :: User PatchTag = User.empty schemas' "hello" extras
-      for_
-        [ ("username", String "lol"),
-          ("displayname", String "lol"),
-          ("externalid", String "lol"),
-          ("active", Bool True)
-        ]
-        $ \(key, upd) -> do
-          let operation = Operation Replace (Just (NormalPath (AttrPath Nothing key Nothing))) (Just upd)
-          let patchOp = PatchOp [operation]
-          User.applyPatch user patchOp `shouldSatisfy` isRight
-    it "does not support multi-value attributes" $ do
-      let schemas' = []
-      let extras = KeyMap.empty
-      let user :: User PatchTag = User.empty schemas' "hello" extras
-      for_
-        [ ("schemas", toJSON @[Schema] mempty),
-          ("name", toJSON @Name emptyName),
-          ("nickName", toJSON @Text mempty),
-          ("profileUrl", toJSON @URI (URI [uri|https://example.com|])),
-          ("title", toJSON @Text mempty),
-          ("userType", toJSON @Text mempty),
-          ("preferredLanguage", toJSON @Text mempty),
-          ("locale", toJSON @Text mempty),
-          ("password", toJSON @Text mempty),
-          ("emails", toJSON @[Email] mempty),
-          ("phoneNumbers", toJSON @[Phone] mempty),
-          ("ims", toJSON @[IM] mempty),
-          ("photos", toJSON @[Photo] mempty),
-          ("addresses", toJSON @[Address] mempty),
-          ("entitlements", toJSON @[Text] mempty),
-          ("x509Certificates", toJSON @[Certificate] mempty)
-        ]
-        $ \(key, upd) -> do
-          let operation = Operation Replace (Just (NormalPath (AttrPath Nothing key Nothing))) (Just upd)
-          let patchOp = PatchOp [operation]
-          User.applyPatch user patchOp `shouldSatisfy` isLeft
-    it "applies patch to `extra`" $ do
-      let schemas' = []
-      let extras = KeyMap.empty
-      let user :: User PatchTag = User.empty schemas' "hello" extras
-      let Right programmingLanguagePath = PatchOp.parsePath (User.supportedSchemas @PatchTag) "urn:hscim:test:programmingLanguage"
-      let operation = Operation Replace (Just programmingLanguagePath) (Just (toJSON @Text "haskell"))
-      let patchOp = PatchOp [operation]
-      User.extra <$> User.applyPatch user patchOp `shouldBe` Right (KeyMap.singleton "programmingLanguage" "haskell")
   describe "JSON serialization" $ do
     it "handles all fields" $ do
       require prop_roundtrip
@@ -158,14 +100,14 @@ spec = do
     it "has defaults for all optional and multi-valued fields" $ do
       toJSON minimalUser `shouldBe` minimalUserJson
       eitherDecode (encode minimalUserJson) `shouldBe` Right minimalUser
-    it "treats 'null' and '[]' as absence of fields" $
+    it "treats 'null' and '[]' as absence of fields" $ do
       eitherDecode (encode minimalUserJsonRedundant)
         `shouldBe` Right minimalUser
     it "allows casing variations in field names" $ do
       require $ mk_prop_caseInsensitive genUser
       require $ mk_prop_caseInsensitive (ListResponse.fromList . (: []) <$> genStoredUser)
       eitherDecode (encode minimalUserJsonNonCanonical) `shouldBe` Right minimalUser
-    it "doesn't require the 'schemas' field" $
+    it "doesn't require the 'schemas' field" $ do
       eitherDecode (encode minimalUserJsonNoSchemas)
         `shouldBe` Right minimalUser
     it "doesn't add 'extra' if it's an empty object" $ do
@@ -227,7 +169,7 @@ genUser = do
   let entitlements' = [] -- Gen.list (Range.constant 0 20) (Gen.text (Range.constant 0 20) Gen.unicode)
   let roles' = [] -- Gen.list (Range.constant 0 20) (Gen.text (Range.constant 0 10) Gen.unicode)
   let x509Certificates' = [] -- Gen.list (Range.constant 0 20) genCertificate
-  pure $
+  pure
     User
       { schemas = schemas',
         userName = userName',
@@ -261,7 +203,7 @@ completeUser =
       userName = "sample userName",
       externalId = Just "sample externalId",
       name =
-        Just $
+        Just
           Name
             { Name.formatted = Just "sample formatted name",
               Name.familyName = Nothing,
@@ -484,9 +426,6 @@ instance ToJSON UserExtraTest where
   toJSON (UserExtraObject t) =
     object ["urn:hscim:test" .= object ["test" .= t]]
 
-instance Patchable UserExtraTest where
-  applyOperation _ _ = undefined
-
 -- | A 'User' with extra fields present.
 extendedUser :: UserExtraTest -> User (TestTag Text () () UserExtraTest)
 extendedUser e =
diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs
index 174a4ef6b1..dd1cb47f3c 100644
--- a/libs/wire-api/src/Wire/API/User/Scim.hs
+++ b/libs/wire-api/src/Wire/API/User/Scim.hs
@@ -43,7 +43,6 @@
 module Wire.API.User.Scim where
 
 import Control.Lens (makeLenses, to, (.~), (^.))
-import Control.Monad.Except (throwError)
 import Crypto.Hash (hash)
 import Crypto.Hash.Algorithms (SHA512)
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -57,7 +56,6 @@ import Data.Code as Code
 import Data.Handle (Handle)
 import Data.Id
 import Data.Json.Util
-import Data.Map qualified as Map
 import Data.Misc (PlainTextPassword6)
 import Data.OpenApi qualified as S
 import Data.Schema as Schema
@@ -74,16 +72,10 @@ import Servant.API (FromHttpApiData (..), ToHttpApiData (..))
 import Test.QuickCheck (Gen)
 import Test.QuickCheck qualified as QC
 import Web.HttpApiData (parseHeaderWithPrefix)
-import Web.Scim.AttrName (AttrName (..))
 import Web.Scim.Class.Auth qualified as Scim.Auth
 import Web.Scim.Class.Group qualified as Scim.Group
 import Web.Scim.Class.User qualified as Scim.User
-import Web.Scim.Filter (AttrPath (..))
 import Web.Scim.Schema.Common qualified as Scim
-import Web.Scim.Schema.Error qualified as Scim
-import Web.Scim.Schema.PatchOp (Operation (..), Path (NormalPath))
-import Web.Scim.Schema.PatchOp qualified as Scim
-import Web.Scim.Schema.Schema (Schema (CustomSchema))
 import Web.Scim.Schema.Schema qualified as Scim
 import Web.Scim.Schema.User qualified as Scim
 import Web.Scim.Schema.User qualified as Scim.User
@@ -308,40 +300,6 @@ instance QC.Arbitrary (Scim.User SparTag) where
       genExtra :: QC.Gen ScimUserExtra
       genExtra = QC.arbitrary
 
-instance Scim.Patchable ScimUserExtra where
-  applyOperation (ScimUserExtra (RI.RichInfo rinfRaw)) (Operation o (Just (NormalPath (AttrPath (Just (CustomSchema sch)) (AttrName (CI.mk -> ciAttrName)) Nothing))) val)
-    | sch == RI.richInfoMapURN =
-        let rinf = RI.richInfoMap $ RI.fromRichInfoAssocList rinfRaw
-            unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . RI.mkRichInfoMapAndList . fmap (uncurry RI.RichField) . Map.assocs
-         in unrinf <$> case o of
-              Scim.Remove ->
-                pure $ Map.delete ciAttrName rinf
-              _AddOrReplace ->
-                case val of
-                  (Just (A.String textVal)) ->
-                    pure $ Map.insert ciAttrName textVal rinf
-                  _ -> throwError $ Scim.badRequest Scim.InvalidValue $ Just "rich info values can only be text"
-    | sch == RI.richInfoAssocListURN =
-        let rinf = RI.richInfoAssocList $ RI.fromRichInfoAssocList rinfRaw
-            unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . RI.mkRichInfoMapAndList
-            matchesAttrName (RI.RichField k _) = k == ciAttrName
-         in unrinf <$> case o of
-              Scim.Remove ->
-                pure $ filter (not . matchesAttrName) rinf
-              _AddOrReplace ->
-                case val of
-                  (Just (A.String textVal)) ->
-                    let newField = RI.RichField ciAttrName textVal
-                        replaceIfMatchesAttrName f = if matchesAttrName f then newField else f
-                        newRichInfo =
-                          if not $ any matchesAttrName rinf
-                            then rinf ++ [newField]
-                            else map replaceIfMatchesAttrName rinf
-                     in pure newRichInfo
-                  _ -> throwError $ Scim.badRequest Scim.InvalidValue $ Just "rich info values can only be text"
-    | otherwise = throwError $ Scim.badRequest Scim.InvalidValue $ Just "unknown schema, cannot patch"
-  applyOperation _ _ = throwError $ Scim.badRequest Scim.InvalidValue $ Just "invalid patch op for rich info"
-
 -- | SCIM user with all the data spar is actively processing.  Constructed by
 -- 'validateScimUser', or manually from data obtained from brig to pass them on to scim peers.
 -- The idea is that the type we get back from hscim is too general, and

From 3c15a8fac287b4648008a1c345b82eb83fc19de9 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Mon, 22 Dec 2025 16:24:36 +0100
Subject: [PATCH 02/13] Revert "[WIP]"

This reverts commit d1e460034ae25c337364fef8734c7ace94a4e0e3.
---
 libs/hscim/default.nix                     |  10 +-
 libs/hscim/hscim.cabal                     |   7 +-
 libs/hscim/src/Web/Scim/Class/User.hs      |  15 +-
 libs/hscim/src/Web/Scim/Client.hs          |   2 +-
 libs/hscim/src/Web/Scim/Filter.hs          |   9 -
 libs/hscim/src/Web/Scim/Schema/Common.hs   |   2 +-
 libs/hscim/src/Web/Scim/Schema/PatchOp.hs  | 284 +++++++++------------
 libs/hscim/src/Web/Scim/Schema/User.hs     |  98 ++++++-
 libs/hscim/test/Test/Class/UserSpec.hs     |   6 +-
 libs/hscim/test/Test/FilterSpec.hs         |  57 -----
 libs/hscim/test/Test/Schema/PatchOpSpec.hs | 218 ++++++++--------
 libs/hscim/test/Test/Schema/UserSpec.hs    |  69 ++++-
 libs/wire-api/src/Wire/API/User/Scim.hs    |  42 +++
 13 files changed, 446 insertions(+), 373 deletions(-)

diff --git a/libs/hscim/default.nix b/libs/hscim/default.nix
index f906963c17..d0a64d40d0 100644
--- a/libs/hscim/default.nix
+++ b/libs/hscim/default.nix
@@ -4,7 +4,6 @@
 # dependencies are added or removed.
 { mkDerivation
 , aeson
-, aeson-diff
 , aeson-qq
 , attoparsec
 , attoparsec-aeson
@@ -25,7 +24,6 @@
 , http-types
 , HUnit
 , hw-hspec-hedgehog
-, imports
 , indexed-traversable
 , lens-aeson
 , lib
@@ -34,7 +32,6 @@
 , mmorph
 , mtl
 , network-uri
-, QuickCheck
 , retry
 , scientific
 , servant
@@ -63,7 +60,6 @@ mkDerivation {
   isExecutable = true;
   libraryHaskellDepends = [
     aeson
-    aeson-diff
     aeson-qq
     attoparsec
     attoparsec-aeson
@@ -79,7 +75,6 @@ mkDerivation {
     http-api-data
     http-media
     http-types
-    imports
     list-t
     microlens
     mmorph
@@ -114,8 +109,7 @@ mkDerivation {
   ];
   testHaskellDepends = [
     aeson
-    aeson-diff
-    aeson-qq
+    attoparsec
     base
     bytestring
     email-validate
@@ -126,12 +120,10 @@ mkDerivation {
     http-types
     HUnit
     hw-hspec-hedgehog
-    imports
     indexed-traversable
     lens-aeson
     microlens
     network-uri
-    QuickCheck
     servant
     servant-server
     stm-containers
diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index a63e58efb4..73814d4a55 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -86,7 +86,6 @@ library
   ghc-options:        -Wall -Wredundant-constraints -Wunused-packages
   build-depends:
       aeson
-    , aeson-diff
     , aeson-qq
     , attoparsec
     , attoparsec-aeson
@@ -102,7 +101,6 @@ library
     , http-api-data
     , http-media
     , http-types
-    , imports
     , list-t
     , microlens
     , mmorph
@@ -212,8 +210,7 @@ test-suite spec
   build-tool-depends: hspec-discover:hspec-discover
   build-depends:
       aeson
-    , aeson-diff
-    , aeson-qq
+    , attoparsec
     , base
     , bytestring
     , email-validate
@@ -225,12 +222,10 @@ test-suite spec
     , http-types
     , HUnit
     , hw-hspec-hedgehog
-    , imports
     , indexed-traversable
     , lens-aeson
     , microlens
     , network-uri
-    , QuickCheck
     , servant
     , servant-server
     , stm-containers
diff --git a/libs/hscim/src/Web/Scim/Class/User.hs b/libs/hscim/src/Web/Scim/Class/User.hs
index a54fa0b8ca..982ad3700e 100644
--- a/libs/hscim/src/Web/Scim/Class/User.hs
+++ b/libs/hscim/src/Web/Scim/Class/User.hs
@@ -26,7 +26,7 @@ module Web.Scim.Class.User
   )
 where
 
-import Data.Aeson.Types (FromJSON, ToJSON)
+import Data.Aeson.Types (FromJSON)
 import Servant
 import Servant.API.Generic
 import Servant.Server.Generic
@@ -66,8 +66,8 @@ data UserSite tag route = UserSite
     usPatchUser ::
       route
         :- Capture "id" (UserId tag)
-          :> ReqBody '[SCIM] PatchOp
-          :> Servant.Patch '[SCIM] (StoredUser tag),
+          :> ReqBody '[SCIM] (PatchOp tag)
+          :> Patch '[SCIM] (StoredUser tag),
     usDeleteUser ::
       route
         :- Capture "id" (UserId tag)
@@ -135,17 +135,18 @@ class (Monad m, AuthTypes tag, UserTypes tag) => UserDB tag m where
     AuthInfo tag ->
     UserId tag ->
     -- | PATCH payload
-    PatchOp ->
+    PatchOp tag ->
     ScimHandler m (StoredUser tag)
   default patchUser ::
-    (FromJSON (UserExtra tag), ToJSON (UserExtra tag)) =>
+    (Patchable (UserExtra tag), FromJSON (UserExtra tag)) =>
     AuthInfo tag ->
     UserId tag ->
-    PatchOp ->
+    -- | PATCH payload
+    PatchOp tag ->
     ScimHandler m (StoredUser tag)
   patchUser info uid op' = do
     (WithMeta _ (WithId _ (user :: User tag))) <- getUser info uid
-    (newUser :: User tag) <- applyPatch op' user
+    (newUser :: User tag) <- applyPatch user op'
     putUser info uid newUser
 
   -- | Delete a user.
diff --git a/libs/hscim/src/Web/Scim/Client.hs b/libs/hscim/src/Web/Scim/Client.hs
index eb6d17d62e..c80070fb03 100644
--- a/libs/hscim/src/Web/Scim/Client.hs
+++ b/libs/hscim/src/Web/Scim/Client.hs
@@ -148,7 +148,7 @@ patchUser ::
   ClientEnv ->
   Maybe (AuthData tag) ->
   UserId tag ->
-  PatchOp ->
+  PatchOp tag ->
   IO (StoredUser tag)
 patchUser env tok = case users (scimClients env) tok of ((_ :<|> (_ :<|> _)) :<|> (_ :<|> (r :<|> _))) -> r
 
diff --git a/libs/hscim/src/Web/Scim/Filter.hs b/libs/hscim/src/Web/Scim/Filter.hs
index 3a1b18d976..5862f6a36b 100644
--- a/libs/hscim/src/Web/Scim/Filter.hs
+++ b/libs/hscim/src/Web/Scim/Filter.hs
@@ -67,7 +67,6 @@ import Data.String
 import Data.Text (Text, isInfixOf, isPrefixOf, isSuffixOf, pack)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Text.Lazy (toStrict)
-import Imports (todo)
 import Lens.Micro
 import Web.HttpApiData
 import Web.Scim.AttrName
@@ -155,8 +154,6 @@ topLevelAttrPath x = AttrPath Nothing (AttrName x) Nothing
 -- @
 -- is not supported
 
--- TODO: why is there no declaration here?
-
 ----------------------------------------------------------------------------
 -- Parsing
 
@@ -294,9 +291,3 @@ instance FromHttpApiData Filter where
 
 instance ToHttpApiData Filter where
   toUrlPiece = renderFilter
-
-instance ToJSON AttrPath where
-  toJSON = toJSON . rAttrPath
-
-instance FromJSON AttrPath where
-  parseJSON = todo
diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs
index d1d080a15f..c0adb84c21 100644
--- a/libs/hscim/src/Web/Scim/Schema/Common.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Common.hs
@@ -40,7 +40,7 @@ data WithId id a = WithId
 
 instance (ToJSON id, ToJSON a) => ToJSON (WithId id a) where
   toJSON (WithId i v) = case toJSON v of
-    (Object o) -> Object (KeyMap.insert (Key.fromString "id") (toJSON i) o)
+    (Object o) -> Object (KeyMap.insert "id" (toJSON i) o)
     other -> other
 
 instance (FromJSON id, FromJSON a) => FromJSON (WithId id a) where
diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
index 7924f7021a..1ac01c3b16 100644
--- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
+++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ViewPatterns #-}
-
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
@@ -19,180 +17,134 @@
 
 module Web.Scim.Schema.PatchOp where
 
-import Control.Monad.Error.Class (MonadError, throwError)
-import Data.Aeson
-import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.:), (.:?), (.=))
-import qualified Data.Aeson.Diff as AD
-import qualified Data.Aeson.KeyMap as AK
-import qualified Data.Aeson.Pointer as AD
-import Data.Aeson.Types (Parser)
+import Control.Applicative
+import Control.Monad (guard)
+import Control.Monad.Except
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.KeyMap as KeyMap
+import Data.Aeson.Types (FromJSON (parseJSON), ToJSON (toJSON), Value (String), object, withObject, withText, (.:), (.:?), (.=))
+import qualified Data.Aeson.Types as Aeson
+import Data.Attoparsec.ByteString (Parser, endOfInput, parseOnly)
 import Data.Bifunctor (first)
 import qualified Data.CaseInsensitive as CI
-import Data.List.NonEmpty
 import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text as Text
-import Imports
-import Web.Scim.Filter
+import Data.Text.Encoding (encodeUtf8)
+import Web.Scim.AttrName (AttrName (..))
+import Web.Scim.Filter (AttrPath (..), SubAttr (..), ValuePath (..), pAttrPath, pSubAttr, pValuePath, rAttrPath, rSubAttr, rValuePath)
 import Web.Scim.Schema.Common (lowerKey)
 import Web.Scim.Schema.Error
-import Web.Scim.Schema.Schema
+import Web.Scim.Schema.Schema (Schema (PatchOp20))
+import Web.Scim.Schema.UserTypes (UserTypes (supportedSchemas))
 
--- This type provides the parser for the scim patch syntax, and can be
--- turned into an `AD.Patch` with `validatePatchOp`.
---
--- Differences to AD.Patch:
--- - Only add, remove, replace.
--- - Point into array with filters, not indices.
--- - Case insensitive.
--- - The semantics is a bit convoluted and may diverge from that of
---   `AD.Patch` (see RFCs).
---
--- Example:
---
---    { "schemas":
---        ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
---      "Operations":[
---        {
---         "op":"add",
---         "path":"members",
---         "value":[
---          {
---            "display": "Babs Jensen",
---            "$ref": "https://example.com/v2/Users/2819c223...413861904646",
---            "value": "2819c223-7f76-453a-919d-413861904646"
---          }
---         ]
---        },
---        ... + additional operations if needed ...
---      ]
---    }
---
--- patch for scim: https://datatracker.ietf.org/doc/html/rfc7644#section-3.5.2
--- patch for json: https://datatracker.ietf.org/doc/html/rfc6901
-newtype Patch = Patch {fromPatch :: [PatchOp]}
+newtype PatchOp tag = PatchOp
+  {getOperations :: [Operation]}
   deriving (Eq, Show)
 
-data PatchOp
-  = PatchOpAdd (Maybe AttrPath) Value
-  | PatchOpRemove AttrPath
-  | PatchOpReplace (Maybe AttrPath) Value
+-- | The 'Path' attribute value is a 'String' containing an attribute path
+-- describing the target of the operation.  It is OPTIONAL
+-- for 'Op's "add" and "replace", and is REQUIRED for "remove".  See
+-- relevant operation sections below for details.
+--
+-- TODO(arianvp):  When value is an array, it needs special handling.
+-- e.g. primary fields need to be negated and whatnot.
+-- We currently do not do that :)
+--
+-- NOTE: When the path contains a schema, this schema must be implicitly added
+-- to the list of schemas on the result type
+data Operation = Operation
+  { op :: Op,
+    path :: Maybe Path,
+    value :: Maybe Value
+  }
   deriving (Eq, Show)
 
-----------------------------------------------------------------------
+data Op
+  = Add
+  | Replace
+  | Remove
+  deriving (Eq, Show, Enum, Bounded)
 
-instance ToJSON Patch where
-  toJSON = todo
+-- | PATH = attrPath / valuePath [subAttr]
+data Path
+  = NormalPath AttrPath
+  | IntoValuePath ValuePath (Maybe SubAttr)
+  deriving (Eq, Show)
 
-instance ToJSON PatchOp where
-  toJSON op =
-    object $
-      ["op" .= String (patchOpName op)]
-        <> ["path" .= p | p <- maybeToList $ patchOpPath op]
-        <> ["val" .= v | v <- maybeToList $ patchOpVal op]
+parsePath :: [Schema] -> Text -> Either String Path
+parsePath schemas' = parseOnly (pPath schemas' <* endOfInput) . encodeUtf8
+
+-- | PATH = attrPath / valuePath [subAttr]
+pPath :: [Schema] -> Parser Path
+pPath schemas' =
+  IntoValuePath <$> pValuePath schemas' <*> optional pSubAttr
+    <|> NormalPath <$> pAttrPath schemas'
+
+rPath :: Path -> Text
+rPath (NormalPath attrPath) = rAttrPath attrPath
+rPath (IntoValuePath valuePath subAttr) = rValuePath valuePath <> maybe "" rSubAttr subAttr
+
+-- TODO(arianvp): According to the SCIM spec we should throw an InvalidPath
+-- error when the path is invalid syntax. this is a bit hard to do though as we
+-- can't control what errors FromJSON throws :/
+instance (UserTypes tag) => FromJSON (PatchOp tag) where
+  parseJSON = withObject "PatchOp" $ \v -> do
+    let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v
+    schemas' :: [Schema] <- o .: "schemas"
+    guard $ PatchOp20 `elem` schemas'
+    operations <- Aeson.explicitParseField (Aeson.listParser $ operationFromJSON (supportedSchemas @tag)) o "operations"
+    pure $ PatchOp operations
+
+instance ToJSON (PatchOp tag) where
+  toJSON (PatchOp operations) =
+    object ["operations" .= operations, "schemas" .= [PatchOp20]]
+
+-- TODO: Azure wants us to be case-insensitive on _values_ as well here.  We currently do not
+-- comply with that.
+operationFromJSON :: [Schema] -> Value -> Aeson.Parser Operation
+operationFromJSON schemas' =
+  withObject "Operation" $ \v -> do
+    let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v
+    Operation
+      <$> (o .: "op")
+      <*> Aeson.explicitParseFieldMaybe (pathFromJSON schemas') o "path"
+      <*> (o .:? "value")
+
+pathFromJSON :: [Schema] -> Value -> Aeson.Parser Path
+pathFromJSON schemas' =
+  withText "Path" $ either fail pure . parsePath schemas'
+
+instance ToJSON Operation where
+  toJSON (Operation op' path' value') =
+    object $ ("op" .= op') : optionalField "path" path' ++ optionalField "value" value'
     where
-      patchOpName :: PatchOp -> Text
-      patchOpName = \case
-        PatchOpAdd _ _ -> "add"
-        PatchOpRemove _ -> "remove"
-        PatchOpReplace _ _ -> "replace"
-
-      patchOpPath :: PatchOp -> Maybe AttrPath
-      patchOpPath = \case
-        PatchOpAdd mbp _ -> mbp
-        PatchOpRemove p -> Just $ p
-        PatchOpReplace mbp _ -> mbp
-
-      patchOpVal :: PatchOp -> Maybe Value
-      patchOpVal = \case
-        PatchOpAdd _ v -> Just v
-        PatchOpRemove _ -> Nothing
-        PatchOpReplace _ v -> Just v
-
-----------------------------------------------------------------------
-
-instance FromJSON Patch where
-  parseJSON = todo
-
-instance FromJSON PatchOp where
-  parseJSON = withObject "PatchOp" $ \o -> do
-    o .: "op" >>= \case
-      "add" -> do
-        path <- o .:? "path"
-        val <- o .: "value"
-        pure $ PatchOpAdd path val
-      "remove" -> do
-        path <- o .: "path"
-        pure $ PatchOpRemove path
-      "replace" -> do
-        path <- o .:? "path"
-        val <- o .: "value"
-        pure $ PatchOpReplace path val
-      unknownOp -> fail $ "Unknown operation: " ++ T.unpack unknownOp
-
-{-
-
--- TODO: full SCIM path with filter expressions
-scimPathToPointer :: Text -> AD.Pointer
-scimPathToPointer = undefined -- path = map AD.OKey $ T.split (== '.') $ T.dropWhile (== '/') path
-
-pointerToScimPath :: AD.Pointer -> Text
-pointerToScimPath keys =
-  {-
-  T.intercalate "." $ map keyToText keys
-  where
-    keyToText (AD.OKey k) = k
-    keyToText (AD.AKey i) = T.pack (show i)
-  -}
-  undefined
-
--}
-
-----------------------------------------------------------------------
-
--- TODO: use this to apply a list of patches so we only have to call AD.patch once.
-applyPatch :: forall m a. (FromJSON a, ToJSON a, MonadError ScimError m) => PatchOp -> a -> m a
-applyPatch = todo
-
-{-
-
-applyPatch hscimOp (toJSON -> jsonOrig) = do
-  patch <-
-    validatePatchOp hscimOp
-      & let err = throwError . badRequest InvalidSyntax . Just . Text.pack
-         in either err pure
-  jsonPatched <-
-    AD.patch patch jsonOrig
-      & let err = throwError . badRequest InvalidValue . Just . ("could not apply patch: " <>) . Text.pack
-         in \case
-              Success val -> pure val
-              Error txt -> err txt
-  fromJSON jsonPatched
-    & let err = throwError . badRequest InvalidPath . Just . ("could not apply patch: " <>) . Text.pack
-       in \case
-            Success val -> pure val
-            Error txt -> err txt
-
-validatePatchOp :: forall m. (MonadError String m) => PatchOp -> Value -> m AD.Patch
-validatePatchOp (PatchOp _) = do
-  -- opOk `mapM_` undefined
-  pure undefined
-  where
-    opOk :: AD.Operation -> m ()
-    opOk = \case
-      AD.Add path _ -> pathOk path
-      AD.Rem path -> pathOk path
-      AD.Rep path _ -> pathOk path
-      AD.Mov {} -> throwError "unsupported patch operation: mov"
-      AD.Cpy {} -> throwError "unsupported patch operation: cpy"
-      AD.Tst {} -> throwError "unsupported patch operation: tst"
-
-    pathOk :: AD.Pointer -> m ()
-    pathOk (AD.Pointer path) = keyOk `mapM_` path
-
-    keyOk :: AD.Key -> m ()
-    keyOk = \case
-      AD.OKey {} -> pure ()
-      AD.AKey {} -> throwError "unsupported key type: index" -- TODO: make this work!
-
--}
+      optionalField fname = \case
+        Nothing -> []
+        Just x -> [fname .= x]
+
+instance FromJSON Op where
+  parseJSON = withText "Op" $ \op' ->
+    case CI.foldCase op' of
+      "add" -> pure Add
+      "replace" -> pure Replace
+      "remove" -> pure Remove
+      _ -> fail "unknown operation"
+
+instance ToJSON Op where
+  toJSON Add = String "add"
+  toJSON Replace = String "replace"
+  toJSON Remove = String "remove"
+
+instance ToJSON Path where
+  toJSON = String . rPath
+
+-- | A very coarse description of what it means to be 'Patchable'
+-- I do not like it. We should handhold people using this library more
+class Patchable a where
+  applyOperation :: (MonadError ScimError m) => a -> Operation -> m a
+
+instance Patchable (KeyMap.KeyMap Text) where
+  applyOperation theMap (Operation Remove (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) _) =
+    pure $ KeyMap.delete (Key.fromText attrName) theMap
+  applyOperation theMap (Operation _AddOrReplace (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) (Just (String val))) =
+    pure $ KeyMap.insert (Key.fromText attrName) val theMap
+  applyOperation _ _ = throwError $ badRequest InvalidValue $ Just "Unsupported operation"
diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs
index 160f6e4129..1a37f6dae6 100644
--- a/libs/hscim/src/Web/Scim/Schema/User.hs
+++ b/libs/hscim/src/Web/Scim/Schema/User.hs
@@ -64,21 +64,29 @@ module Web.Scim.Schema.User
   ( User (..),
     empty,
     NoUserExtra (..),
+    applyPatch,
     resultToScimError,
     isUserSchema,
     module Web.Scim.Schema.UserTypes,
   )
 where
 
+import Control.Monad
 import Control.Monad.Except
 import Data.Aeson
+import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KeyMap
+import Data.List ((\\))
 import Data.Text (Text, pack)
+import qualified Data.Text as Text
 import GHC.Generics (Generic)
 import Lens.Micro
+import Web.Scim.AttrName
+import Web.Scim.Filter (AttrPath (..))
 import Web.Scim.Schema.Common
 import Web.Scim.Schema.Error
-import Web.Scim.Schema.Schema (Schema (..))
+import Web.Scim.Schema.PatchOp
+import Web.Scim.Schema.Schema (Schema (..), getSchemaUri)
 import Web.Scim.Schema.User.Address (Address)
 import Web.Scim.Schema.User.Certificate (Certificate)
 import Web.Scim.Schema.User.Email (Email)
@@ -254,13 +262,101 @@ instance FromJSON NoUserExtra where
 instance ToJSON NoUserExtra where
   toJSON _ = object []
 
+instance Patchable NoUserExtra where
+  applyOperation _ _ = throwError $ badRequest InvalidValue (Just "there are no user extra attributes to patch")
+
 ----------------------------------------------------------------------------
 -- Applying
 
+-- | Applies a JSON Patch to a SCIM Core User
+-- Only supports the core attributes.
+-- Evenmore, only some hand-picked ones currently.
+-- We'll have to think how patch is going to work in the presence of extensions.
+-- Also, we can probably make  PatchOp type-safe to some extent (Read arianvp's thesis :))
+applyPatch ::
+  ( Patchable (UserExtra tag),
+    FromJSON (UserExtra tag),
+    MonadError ScimError m,
+    UserTypes tag
+  ) =>
+  User tag ->
+  PatchOp tag ->
+  m (User tag)
+applyPatch = (. getOperations) . foldM applyOperation
+
 resultToScimError :: (MonadError ScimError m) => Result a -> m a
 resultToScimError (Error reason) = throwError $ badRequest InvalidValue (Just (pack reason))
 resultToScimError (Success a) = pure a
 
+-- TODO(arianvp): support multi-valued and complex attributes.
+-- TODO(arianvp): Actually do this in some kind of type-safe way. e.g.
+-- have a UserPatch type.
+--
+-- What I understand from the spec:  The difference between add an replace is only
+-- in the fact that replace will not concat multi-values, and behaves differently for complex values too.
+-- For simple attributes, add and replace are identical.
+applyUserOperation ::
+  forall m tag.
+  ( UserTypes tag,
+    FromJSON (User tag),
+    Patchable (UserExtra tag),
+    MonadError ScimError m
+  ) =>
+  User tag ->
+  Operation ->
+  m (User tag)
+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
+    "username" ->
+      (\x -> user {userName = x}) <$> resultToScimError (fromJSON value)
+    "displayname" ->
+      (\x -> user {displayName = x}) <$> resultToScimError (fromJSON value)
+    "externalid" ->
+      (\x -> user {externalId = x}) <$> resultToScimError (fromJSON value)
+    "active" ->
+      (\x -> user {active = x}) <$> resultToScimError (fromJSON value)
+    "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", "roles"]) -> do
+      (u :: User tag) <- resultToScimError $ fromJSON value
+      pure $
+        user
+          { userName = userName u,
+            displayName = displayName u,
+            externalId = externalId u,
+            active = active u
+          }
+    _ -> 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)
+applyUserOperation user (Operation Remove (Just (NormalPath (AttrPath _schema attr _subAttr))) _value) =
+  case attr of
+    "username" -> throwError (badRequest Mutability Nothing)
+    "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"))
+
+instance (UserTypes tag, FromJSON (User tag), Patchable (UserExtra tag)) => Patchable (User tag) where
+  applyOperation user op@(Operation _ (Just (NormalPath (AttrPath schema _ _))) _)
+    | isUserSchema schema = applyUserOperation user op
+    | isSupportedCustomSchema schema = (\x -> user {extra = x}) <$> applyOperation (extra user) op
+    | otherwise =
+        throwError $ badRequest InvalidPath $ Just $ "we only support these schemas: " <> Text.intercalate ", " (map getSchemaUri (supportedSchemas @tag))
+    where
+      isSupportedCustomSchema = maybe False (`elem` supportedSchemas @tag)
+  applyOperation user op = applyUserOperation user op
+
 -- Omission of a schema for users is implicitly the core schema
 -- TODO(arianvp): Link to part of the spec that claims this.
 isUserSchema :: Maybe Schema -> Bool
diff --git a/libs/hscim/test/Test/Class/UserSpec.hs b/libs/hscim/test/Test/Class/UserSpec.hs
index de3f77a37a..6a46738dcc 100644
--- a/libs/hscim/test/Test/Class/UserSpec.hs
+++ b/libs/hscim/test/Test/Class/UserSpec.hs
@@ -363,9 +363,9 @@ spec = with app $ do
         patch
           "/0"
           [scim|{
-            "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-            "operations": [{ "op": "remove", "path": "displayName"}]
-          }|]
+          "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+          "Operations": [{ "op": "Remove", "path": "displayName"}]
+        }|]
           `shouldRespondWith` [scim|{
           "schemas": [
             "urn:ietf:params:scim:schemas:core:2.0:User"
diff --git a/libs/hscim/test/Test/FilterSpec.hs b/libs/hscim/test/Test/FilterSpec.hs
index d436fbc28d..9fc6588e7f 100644
--- a/libs/hscim/test/Test/FilterSpec.hs
+++ b/libs/hscim/test/Test/FilterSpec.hs
@@ -42,63 +42,6 @@ spec = do
   describe "Filter" $ do
     it "parse . render === id" $ require $ prop_roundtrip @(TestTag Text () () NoUserExtra)
 
-    describe "golden tests" $ do
-      {-
-      describe "attribute paths" $ do
-        let examples :: [(String, Either String Path)]
-            examples =
-              [ ( "members",
-                  Right $ Path $ PathSegField "members" NE.:| []
-                ),
-                ( "name.familyname",
-                  Right $ Path $ PathSegField "name" NE.:| [PathSegField "familyname"]
-                ),
-                ( "addresses[type eq \"work\"]",
-                  Right $ Path $ PathSegField "addresses" NE.:| [readFilter "type eq \"work\""]
-                ),
-                ( "members[value eq \"2819c223-7f76-453a-919d-413861904646\"]",
-                  Right $ Path $ PathSegField "members" NE.:| [readFilter "value eq \"2819c223-7f76-453a-919d-413861904646\""]
-                ),
-                ( "members[type eq \"work\"].displayname",
-                  Right $ Path $ PathSegField "members" NE.:| [readFilter "type eq \"work\"", PathSegField "displayName"]
-                ),
-                ( "members[type lq \"work\" and value eq \"\"]".displayname,
-                  Right $ Path $ PathSegField "members" NE.:| [readFilter "members[type lq \"work\" and value eq \"\"]", PathSegField "displayName"]
-                ),
-                -- weird stuff
-                ( "",
-                  Left ""
-                ),
-                ( ".members",
-                  Left ""
-                ),
-                ( "urn:ietf:params:scim:schemas:core:2.0:Group:.nosuchfield",
-                  Left ""
-                ),
-                ( "urn:ietf:params:scim:schemas:core:2.0:Group:.members",
-                  Left "this should actually work, no?"
-                )
-              ]
-
-            readFilter :: Text -> PathSeg
-            readFilter = either (error "impossible") PathSegArrayFilter . parseFilter []
-
-         for_ examples $ \(ex, want) -> it ex $ eitherDecode @Path (encode ex) `shouldBe` want
-      -}
-
-      describe "filter" $ do
-        -- TODO: enforce schema User20 and Group20, for now)
-
-        it "1" $ do
-          parseFilter [User20] ""
-            `shouldBe` Left ""
-        it "2" $ do
-          parseFilter [] "nosuchfield co \"yessuchfield\""
-            `shouldBe` Right (FilterAttrCompare (AttrPath Nothing "nosuchfield" Nothing) OpCo (ValString "yessuchfield"))
-        it "3" $ do
-          parseFilter [] ".nosuchfield eq "
-            `shouldBe` Right (FilterAttrCompare (AttrPath Nothing "nosuchfield" Nothing) OpCo ValNull)
-
 ----------------------------------------------------------------------------
 -- Generators
 
diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
index c92f502b41..2e9a041531 100644
--- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs
+++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
@@ -1,7 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -22,121 +20,123 @@
 
 module Test.Schema.PatchOpSpec where
 
-import Data.Aeson
-import qualified Data.Aeson.Diff as AD
+import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.KeyMap as KeyMap
-import qualified Data.Aeson.Pointer as AD
-import Data.Aeson.QQ (aesonQQ)
-import Data.Aeson.Types
-import Data.Either
-import qualified Data.List.NonEmpty as NE
-import Imports
-import Test.Hspec
-import Test.Hspec.QuickCheck
-import Test.QuickCheck
-import Web.Scim.Filter
+import Data.Aeson.Types (Result (Error, Success), Value (String), fromJSON, toJSON)
+import qualified Data.Aeson.Types as Aeson
+import Data.Attoparsec.ByteString (parseOnly)
+import Data.Either (isLeft)
+import Data.Foldable (for_)
+import Data.Text (Text)
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import HaskellWorks.Hspec.Hedgehog (require)
+import Hedgehog (Gen, Property, forAll, property, tripping)
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import Test.FilterSpec (genAttrPath, genSubAttr, genValuePath)
+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy, xit)
+import Test.Schema.Util (mk_prop_caseInsensitive)
+import Web.Scim.AttrName (AttrName (..))
+import Web.Scim.Filter (AttrPath (..), CompValue (ValNull), CompareOp (OpEq), Filter (..), ValuePath (..))
 import Web.Scim.Schema.PatchOp
-import Web.Scim.Schema.User
-import Web.Scim.Test.Util
+import Web.Scim.Schema.Schema (Schema (User20))
+import Web.Scim.Schema.User (UserTypes)
+import Web.Scim.Schema.UserTypes (supportedSchemas)
+import Web.Scim.Test.Util (TestTag, scim)
 
-type PatchTag = TestTag Text () () UserExtraPatch
+isSuccess :: Result a -> Bool
+isSuccess (Success _) = True
+isSuccess (Error _) = False
 
-type UserExtraPatch = KeyMap.KeyMap Text
+genPatchOp :: forall tag. (UserTypes tag) => Gen Value -> Gen (PatchOp tag)
+genPatchOp genValue = PatchOp <$> Gen.list (Range.constant 0 20) ((genOperation @tag) genValue)
 
-spec :: Spec
-spec = do
-  describe "PatchOp" $ do
-    ----------------------------------------------------------------------
-
-    it "golden + simple roundtrip" $ do
-      let check :: (PatchOp, Value) -> Expectation
-          check (hs, js) = do
-            toJSON hs `shouldBe` js
-            case parseEither parseJSON js of
-              Left err -> expectationFailure $ "Failed to parse: " ++ err
-              Right (have :: PatchOp) -> have `shouldBe` hs
+genSimplePatchOp :: forall tag. (UserTypes tag) => Gen (PatchOp tag)
+genSimplePatchOp = genPatchOp @tag (String <$> Gen.text (Range.constant 0 20) Gen.unicode)
 
-      check
-        `mapM_` [ ( todo, -- PatchOp (AD.Patch []),
-                    [aesonQQ|
-                    {
-                    "schemaS": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                      "OperaTions": [{
-                        "oP": "aDD",
-                        "pATh": "userName",
-                        "vaLUE": "testuser"
-                      }]
-                    }
-                    |]
-                  )
-                ]
+genOperation :: forall tag. (UserTypes tag) => Gen Value -> Gen Operation
+genOperation genValue = Operation <$> Gen.enumBounded <*> Gen.maybe (genPath @tag) <*> Gen.maybe genValue
 
-    -- todo "test missing path field for add, rep"
-
-    it "Operation attributes and value attributes are case-insensitive" $ do
-      let patches :: [Value] =
-            [ [aesonQQ|
-              {
-                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                "Operations": [{
-                  "op": "replace",
-                  "path": "displayName",
-                  "value": "Name"
-                }]
-              }
-              |],
-              [aesonQQ|
-              {
-                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                "Operations": [{
-                  "op": "REPLACE",
-                  "path": "displayName",
-                  "value": "Name"
-                }]
-              }
-              |],
-              [aesonQQ|
-              {
-                "Schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                "Operations": [{
-                  "OP": "Replace",
-                  "PATH": "dISPlayName",
-                  "VALUE": "Name"
-                }]
-              }
-              |]
-            ]
-      case nub $ (eitherDecode @PatchOp . encode) <$> patches of
-        [Right _] -> pure ()
-        bad -> expectationFailure $ "Case insensitivity check failed, the following variantions should not be distinguished: " ++ show bad
+genPath :: forall tag. (UserTypes tag) => Gen Path
+genPath =
+  Gen.choice
+    [ IntoValuePath <$> (genValuePath @tag) <*> Gen.maybe genSubAttr,
+      NormalPath <$> (genAttrPath @tag)
+    ]
 
-  describe "applyPatch" $ do
-    prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
-      \(barbie :: User (TestTag Text () () NoUserExtra)) changedWant ->
-        let patchOp = todo -- PatchOp (AD.diff (toJSON barbie) (toJSON changedWant))
-         in applyPatch patchOp barbie === Right changedWant
+prop_roundtrip :: forall tag. (UserTypes tag) => Property
+prop_roundtrip = property $ do
+  x <- forAll $ genPath @tag
+  tripping x (encodeUtf8 . rPath) (parseOnly $ pPath (supportedSchemas @tag))
 
-    it "throws expected error when patched object doesn't parse" $ do
-      () <- todo
-      True `shouldBe` False
+prop_roundtrip_PatchOp :: forall tag. (UserTypes tag) => Property
+prop_roundtrip_PatchOp = property $ do
+  -- Just some strings for now. However, should be constrained to what the
+  -- PatchOp is operating on in the future... We need better typed PatchOp for
+  -- this. TODO(arianvp)
+  x <- forAll (genSimplePatchOp @tag)
+  tripping x toJSON fromJSON
 
-    it "discards all paths that don't match the user/group schema" $ do
-      _ <- todo
-      True `shouldBe` False
+type PatchTestTag = TestTag () () () ()
 
-    it "Throws error when trying to update immutable / readOnly values" $ do
-      -- https://datatracker.ietf.org/doc/html/rfc7644#section-3.5.2
-      _ <- todo
-      True `shouldBe` False
-
-instance Arbitrary (User (TestTag Text () () NoUserExtra)) where
-  -- TODO: move this to test module in library.
-  arbitrary =
-    {-  do
-      userName <- undefined -- Gen.text (Range.constant 1 20) Gen.unicode
-      externalId <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
-      displayName <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
-      active <- undefined -- Gen.maybe $ ScimBool <$> Gen.bool
-      pure (empty [User20] userName NoUserExtra) {externalId = externalId}
-     -}
-    undefined
+spec :: Spec
+spec = do
+  describe "Patchable" $
+    describe "HashMap Text Text" $ do
+      it "supports `Add` operation" $ do
+        let theMap = KeyMap.empty @Text
+            operation = Operation Add (Just $ NormalPath (AttrPath Nothing (AttrName "key") Nothing)) $ Just "value"
+        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key" "value")
+      it "supports `Replace` operation" $ do
+        let theMap = KeyMap.singleton @Text "key" "value1"
+            operation = Operation Replace (Just $ NormalPath (AttrPath Nothing (AttrName "key") Nothing)) $ Just "value2"
+        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key" "value2")
+      it "supports `Delete` operation" $ do
+        let theMap = KeyMap.fromList @Text [("key1", "value1"), ("key2", "value2")]
+            operation = Operation Remove (Just $ NormalPath (AttrPath Nothing (AttrName "key1") Nothing)) Nothing
+        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key2" "value2")
+      it "gracefully rejects invalid/unsupported operations" $ do
+        let theMap = KeyMap.fromList @Text [("key1", "value1"), ("key2", "value2")]
+            key1Path = AttrPath Nothing (AttrName "key1") Nothing
+            key2Path = AttrPath Nothing (AttrName "key2") Nothing
+            invalidOperations =
+              [ Operation Add (Just $ NormalPath key1Path) Nothing, -- Nothing to add
+                Operation Replace (Just $ NormalPath key1Path) Nothing, -- Nothing to replace
+                Operation Add (Just $ IntoValuePath (ValuePath key1Path (FilterAttrCompare key2Path OpEq ValNull)) Nothing) Nothing
+                -- IntoValuePaths don't make sense for HashMap Text Text
+              ]
+        mapM_ (\o -> applyOperation theMap o `shouldSatisfy` isLeft) invalidOperations
+  describe "urn:ietf:params:scim:api:messages:2.0:PatchOp" $ do
+    describe "The body of each request MUST contain the \"schemas\" attribute with the URI value of \"urn:ietf:params:scim:api:messages:2.0:PatchOp\"." $
+      it "rejects an empty schemas list" $ do
+        fromJSON @(PatchOp PatchTestTag)
+          [scim| {
+          "schemas": [],
+          "operations": []
+        }|]
+          `shouldSatisfy` (not . isSuccess)
+    -- TODO(arianvp): We don't support arbitrary path names (yet)
+    it "roundtrips Path" $ require $ prop_roundtrip @PatchTestTag
+    it "roundtrips PatchOp" $ require $ prop_roundtrip_PatchOp @PatchTestTag
+    it "case-insensitive" $ require $ mk_prop_caseInsensitive (genSimplePatchOp @PatchTestTag)
+    it "rejects invalid operations" $
+      fromJSON @(PatchOp PatchTestTag)
+        [scim| {
+          "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+          "operations": [{"op":"unknown"}]
+      }|]
+        `shouldSatisfy` (not . isSuccess)
+    -- TODO(arianvp/akshay): Implement if required
+    xit "rejects unknown paths" $
+      Aeson.parse (pathFromJSON [User20]) (Aeson.String "unknown.field") `shouldSatisfy` (not . isSuccess)
+    it "rejects invalid paths" $
+      Aeson.parse (pathFromJSON [User20]) "unknown]field" `shouldSatisfy` (not . isSuccess)
+    describe "Examples from https://tools.ietf.org/html/rfc7644#section-3.5.2 Figure 8" $ do
+      let examples =
+            [ "members",
+              "name.familyname",
+              "addresses[type eq \"work\"]",
+              "members[value eq \"2819c223-7f76-453a-919d-413861904646\"]",
+              "members[value eq \"2819c223-7f76-453a-919d-413861904646\"].displayname"
+            ]
+      for_ examples $ \p -> it ("parses " ++ show p) $ rPath <$> parseOnly (pPath (supportedSchemas @PatchTestTag)) p `shouldBe` Right (decodeUtf8 p)
diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs
index e27f0eabe6..1885060fac 100644
--- a/libs/hscim/test/Test/Schema/UserSpec.hs
+++ b/libs/hscim/test/Test/Schema/UserSpec.hs
@@ -27,6 +27,8 @@ where
 
 import Data.Aeson
 import qualified Data.Aeson.KeyMap as KeyMap
+import Data.Either (isLeft, isRight)
+import Data.Foldable (for_)
 import Data.Text (Text)
 import HaskellWorks.Hspec.Hedgehog (require)
 import Hedgehog
@@ -38,9 +40,12 @@ import Test.Hspec
 import Test.Schema.Util (genUri, mk_prop_caseInsensitive)
 import Text.Email.Validate (emailAddress, validate)
 import qualified Web.Scim.Class.User as UserClass
+import Web.Scim.Filter (AttrPath (..))
 import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..), WithId (..), lowerKey)
 import qualified Web.Scim.Schema.ListResponse as ListResponse
 import Web.Scim.Schema.Meta (ETag (Strong, Weak), Meta (..), WithMeta (..))
+import Web.Scim.Schema.PatchOp (Op (..), Operation (..), PatchOp (..), Patchable (..), Path (..))
+import qualified Web.Scim.Schema.PatchOp as PatchOp
 import Web.Scim.Schema.Schema (Schema (..))
 import Web.Scim.Schema.User (NoUserExtra (..), User (..))
 import qualified Web.Scim.Schema.User as User
@@ -58,6 +63,10 @@ prop_roundtrip = property $ do
   user <- forAll genUser
   tripping user toJSON fromJSON
 
+type PatchTag = TestTag Text () () UserExtraPatch
+
+type UserExtraPatch = KeyMap.KeyMap Text
+
 spec :: Spec
 spec = do
   describe "scimEmailsToEmailAddress" $ do
@@ -92,6 +101,55 @@ spec = do
         ]
         `shouldBe` Just adr1
 
+  describe "applyPatch" $ do
+    it "only applies patch for supported fields" $ do
+      let schemas' = []
+      let extras = KeyMap.empty
+      let user :: User PatchTag = User.empty schemas' "hello" extras
+      for_
+        [ ("username", String "lol"),
+          ("displayname", String "lol"),
+          ("externalid", String "lol"),
+          ("active", Bool True)
+        ]
+        $ \(key, upd) -> do
+          let operation = Operation Replace (Just (NormalPath (AttrPath Nothing key Nothing))) (Just upd)
+          let patchOp = PatchOp [operation]
+          User.applyPatch user patchOp `shouldSatisfy` isRight
+    it "does not support multi-value attributes" $ do
+      let schemas' = []
+      let extras = KeyMap.empty
+      let user :: User PatchTag = User.empty schemas' "hello" extras
+      for_
+        [ ("schemas", toJSON @[Schema] mempty),
+          ("name", toJSON @Name emptyName),
+          ("nickName", toJSON @Text mempty),
+          ("profileUrl", toJSON @URI (URI [uri|https://example.com|])),
+          ("title", toJSON @Text mempty),
+          ("userType", toJSON @Text mempty),
+          ("preferredLanguage", toJSON @Text mempty),
+          ("locale", toJSON @Text mempty),
+          ("password", toJSON @Text mempty),
+          ("emails", toJSON @[Email] mempty),
+          ("phoneNumbers", toJSON @[Phone] mempty),
+          ("ims", toJSON @[IM] mempty),
+          ("photos", toJSON @[Photo] mempty),
+          ("addresses", toJSON @[Address] mempty),
+          ("entitlements", toJSON @[Text] mempty),
+          ("x509Certificates", toJSON @[Certificate] mempty)
+        ]
+        $ \(key, upd) -> do
+          let operation = Operation Replace (Just (NormalPath (AttrPath Nothing key Nothing))) (Just upd)
+          let patchOp = PatchOp [operation]
+          User.applyPatch user patchOp `shouldSatisfy` isLeft
+    it "applies patch to `extra`" $ do
+      let schemas' = []
+      let extras = KeyMap.empty
+      let user :: User PatchTag = User.empty schemas' "hello" extras
+      let Right programmingLanguagePath = PatchOp.parsePath (User.supportedSchemas @PatchTag) "urn:hscim:test:programmingLanguage"
+      let operation = Operation Replace (Just programmingLanguagePath) (Just (toJSON @Text "haskell"))
+      let patchOp = PatchOp [operation]
+      User.extra <$> User.applyPatch user patchOp `shouldBe` Right (KeyMap.singleton "programmingLanguage" "haskell")
   describe "JSON serialization" $ do
     it "handles all fields" $ do
       require prop_roundtrip
@@ -100,14 +158,14 @@ spec = do
     it "has defaults for all optional and multi-valued fields" $ do
       toJSON minimalUser `shouldBe` minimalUserJson
       eitherDecode (encode minimalUserJson) `shouldBe` Right minimalUser
-    it "treats 'null' and '[]' as absence of fields" $ do
+    it "treats 'null' and '[]' as absence of fields" $
       eitherDecode (encode minimalUserJsonRedundant)
         `shouldBe` Right minimalUser
     it "allows casing variations in field names" $ do
       require $ mk_prop_caseInsensitive genUser
       require $ mk_prop_caseInsensitive (ListResponse.fromList . (: []) <$> genStoredUser)
       eitherDecode (encode minimalUserJsonNonCanonical) `shouldBe` Right minimalUser
-    it "doesn't require the 'schemas' field" $ do
+    it "doesn't require the 'schemas' field" $
       eitherDecode (encode minimalUserJsonNoSchemas)
         `shouldBe` Right minimalUser
     it "doesn't add 'extra' if it's an empty object" $ do
@@ -169,7 +227,7 @@ genUser = do
   let entitlements' = [] -- Gen.list (Range.constant 0 20) (Gen.text (Range.constant 0 20) Gen.unicode)
   let roles' = [] -- Gen.list (Range.constant 0 20) (Gen.text (Range.constant 0 10) Gen.unicode)
   let x509Certificates' = [] -- Gen.list (Range.constant 0 20) genCertificate
-  pure
+  pure $
     User
       { schemas = schemas',
         userName = userName',
@@ -203,7 +261,7 @@ completeUser =
       userName = "sample userName",
       externalId = Just "sample externalId",
       name =
-        Just
+        Just $
           Name
             { Name.formatted = Just "sample formatted name",
               Name.familyName = Nothing,
@@ -426,6 +484,9 @@ instance ToJSON UserExtraTest where
   toJSON (UserExtraObject t) =
     object ["urn:hscim:test" .= object ["test" .= t]]
 
+instance Patchable UserExtraTest where
+  applyOperation _ _ = undefined
+
 -- | A 'User' with extra fields present.
 extendedUser :: UserExtraTest -> User (TestTag Text () () UserExtraTest)
 extendedUser e =
diff --git a/libs/wire-api/src/Wire/API/User/Scim.hs b/libs/wire-api/src/Wire/API/User/Scim.hs
index dd1cb47f3c..174a4ef6b1 100644
--- a/libs/wire-api/src/Wire/API/User/Scim.hs
+++ b/libs/wire-api/src/Wire/API/User/Scim.hs
@@ -43,6 +43,7 @@
 module Wire.API.User.Scim where
 
 import Control.Lens (makeLenses, to, (.~), (^.))
+import Control.Monad.Except (throwError)
 import Crypto.Hash (hash)
 import Crypto.Hash.Algorithms (SHA512)
 import Data.Aeson (FromJSON (..), ToJSON (..))
@@ -56,6 +57,7 @@ import Data.Code as Code
 import Data.Handle (Handle)
 import Data.Id
 import Data.Json.Util
+import Data.Map qualified as Map
 import Data.Misc (PlainTextPassword6)
 import Data.OpenApi qualified as S
 import Data.Schema as Schema
@@ -72,10 +74,16 @@ import Servant.API (FromHttpApiData (..), ToHttpApiData (..))
 import Test.QuickCheck (Gen)
 import Test.QuickCheck qualified as QC
 import Web.HttpApiData (parseHeaderWithPrefix)
+import Web.Scim.AttrName (AttrName (..))
 import Web.Scim.Class.Auth qualified as Scim.Auth
 import Web.Scim.Class.Group qualified as Scim.Group
 import Web.Scim.Class.User qualified as Scim.User
+import Web.Scim.Filter (AttrPath (..))
 import Web.Scim.Schema.Common qualified as Scim
+import Web.Scim.Schema.Error qualified as Scim
+import Web.Scim.Schema.PatchOp (Operation (..), Path (NormalPath))
+import Web.Scim.Schema.PatchOp qualified as Scim
+import Web.Scim.Schema.Schema (Schema (CustomSchema))
 import Web.Scim.Schema.Schema qualified as Scim
 import Web.Scim.Schema.User qualified as Scim
 import Web.Scim.Schema.User qualified as Scim.User
@@ -300,6 +308,40 @@ instance QC.Arbitrary (Scim.User SparTag) where
       genExtra :: QC.Gen ScimUserExtra
       genExtra = QC.arbitrary
 
+instance Scim.Patchable ScimUserExtra where
+  applyOperation (ScimUserExtra (RI.RichInfo rinfRaw)) (Operation o (Just (NormalPath (AttrPath (Just (CustomSchema sch)) (AttrName (CI.mk -> ciAttrName)) Nothing))) val)
+    | sch == RI.richInfoMapURN =
+        let rinf = RI.richInfoMap $ RI.fromRichInfoAssocList rinfRaw
+            unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . RI.mkRichInfoMapAndList . fmap (uncurry RI.RichField) . Map.assocs
+         in unrinf <$> case o of
+              Scim.Remove ->
+                pure $ Map.delete ciAttrName rinf
+              _AddOrReplace ->
+                case val of
+                  (Just (A.String textVal)) ->
+                    pure $ Map.insert ciAttrName textVal rinf
+                  _ -> throwError $ Scim.badRequest Scim.InvalidValue $ Just "rich info values can only be text"
+    | sch == RI.richInfoAssocListURN =
+        let rinf = RI.richInfoAssocList $ RI.fromRichInfoAssocList rinfRaw
+            unrinf = ScimUserExtra . RI.RichInfo . RI.toRichInfoAssocList . RI.mkRichInfoMapAndList
+            matchesAttrName (RI.RichField k _) = k == ciAttrName
+         in unrinf <$> case o of
+              Scim.Remove ->
+                pure $ filter (not . matchesAttrName) rinf
+              _AddOrReplace ->
+                case val of
+                  (Just (A.String textVal)) ->
+                    let newField = RI.RichField ciAttrName textVal
+                        replaceIfMatchesAttrName f = if matchesAttrName f then newField else f
+                        newRichInfo =
+                          if not $ any matchesAttrName rinf
+                            then rinf ++ [newField]
+                            else map replaceIfMatchesAttrName rinf
+                     in pure newRichInfo
+                  _ -> throwError $ Scim.badRequest Scim.InvalidValue $ Just "rich info values can only be text"
+    | otherwise = throwError $ Scim.badRequest Scim.InvalidValue $ Just "unknown schema, cannot patch"
+  applyOperation _ _ = throwError $ Scim.badRequest Scim.InvalidValue $ Just "invalid patch op for rich info"
+
 -- | SCIM user with all the data spar is actively processing.  Constructed by
 -- 'validateScimUser', or manually from data obtained from brig to pass them on to scim peers.
 -- The idea is that the type we get back from hscim is too general, and

From 0bd3be2ca0d003d637585664841a75e93b159d49 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Mon, 22 Dec 2025 16:57:22 +0100
Subject: [PATCH 03/13] Add some dependencies to hscim.

---
 libs/hscim/default.nix | 10 +++++++++-
 libs/hscim/hscim.cabal |  7 ++++++-
 2 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/libs/hscim/default.nix b/libs/hscim/default.nix
index d0a64d40d0..f906963c17 100644
--- a/libs/hscim/default.nix
+++ b/libs/hscim/default.nix
@@ -4,6 +4,7 @@
 # dependencies are added or removed.
 { mkDerivation
 , aeson
+, aeson-diff
 , aeson-qq
 , attoparsec
 , attoparsec-aeson
@@ -24,6 +25,7 @@
 , http-types
 , HUnit
 , hw-hspec-hedgehog
+, imports
 , indexed-traversable
 , lens-aeson
 , lib
@@ -32,6 +34,7 @@
 , mmorph
 , mtl
 , network-uri
+, QuickCheck
 , retry
 , scientific
 , servant
@@ -60,6 +63,7 @@ mkDerivation {
   isExecutable = true;
   libraryHaskellDepends = [
     aeson
+    aeson-diff
     aeson-qq
     attoparsec
     attoparsec-aeson
@@ -75,6 +79,7 @@ mkDerivation {
     http-api-data
     http-media
     http-types
+    imports
     list-t
     microlens
     mmorph
@@ -109,7 +114,8 @@ mkDerivation {
   ];
   testHaskellDepends = [
     aeson
-    attoparsec
+    aeson-diff
+    aeson-qq
     base
     bytestring
     email-validate
@@ -120,10 +126,12 @@ mkDerivation {
     http-types
     HUnit
     hw-hspec-hedgehog
+    imports
     indexed-traversable
     lens-aeson
     microlens
     network-uri
+    QuickCheck
     servant
     servant-server
     stm-containers
diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index 73814d4a55..a63e58efb4 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -86,6 +86,7 @@ library
   ghc-options:        -Wall -Wredundant-constraints -Wunused-packages
   build-depends:
       aeson
+    , aeson-diff
     , aeson-qq
     , attoparsec
     , attoparsec-aeson
@@ -101,6 +102,7 @@ library
     , http-api-data
     , http-media
     , http-types
+    , imports
     , list-t
     , microlens
     , mmorph
@@ -210,7 +212,8 @@ test-suite spec
   build-tool-depends: hspec-discover:hspec-discover
   build-depends:
       aeson
-    , attoparsec
+    , aeson-diff
+    , aeson-qq
     , base
     , bytestring
     , email-validate
@@ -222,10 +225,12 @@ test-suite spec
     , http-types
     , HUnit
     , hw-hspec-hedgehog
+    , imports
     , indexed-traversable
     , lens-aeson
     , microlens
     , network-uri
+    , QuickCheck
     , servant
     , servant-server
     , stm-containers

From acb0c0813ef96269ee58da00f2bfa745a3e80abc Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 23 Dec 2025 12:42:54 +0100
Subject: [PATCH 04/13] Nit-pick (or work around broken tooling).

---
 libs/hscim/src/Web/Scim/Schema/Common.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs
index c0adb84c21..d1d080a15f 100644
--- a/libs/hscim/src/Web/Scim/Schema/Common.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Common.hs
@@ -40,7 +40,7 @@ data WithId id a = WithId
 
 instance (ToJSON id, ToJSON a) => ToJSON (WithId id a) where
   toJSON (WithId i v) = case toJSON v of
-    (Object o) -> Object (KeyMap.insert "id" (toJSON i) o)
+    (Object o) -> Object (KeyMap.insert (Key.fromString "id") (toJSON i) o)
     other -> other
 
 instance (FromJSON id, FromJSON a) => FromJSON (WithId id a) where

From 44beb0ebd4f7cde657c630c36e2fa78d0452e1b3 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Mon, 22 Dec 2025 17:03:38 +0100
Subject: [PATCH 05/13] Add golden tests for Filter, AttrPath, ValuePath.

---
 libs/hscim/hscim.cabal             |   1 +
 libs/hscim/src/Web/Scim/Filter.hs  |  23 ++-
 libs/hscim/test/Test/FilterSpec.hs | 266 ++++++++++++++++++++++++++++-
 3 files changed, 281 insertions(+), 9 deletions(-)

diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index a63e58efb4..b9dff35ef6 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -214,6 +214,7 @@ test-suite spec
       aeson
     , aeson-diff
     , aeson-qq
+    , attoparsec
     , base
     , bytestring
     , email-validate
diff --git a/libs/hscim/src/Web/Scim/Filter.hs b/libs/hscim/src/Web/Scim/Filter.hs
index 5862f6a36b..35aa2353ed 100644
--- a/libs/hscim/src/Web/Scim/Filter.hs
+++ b/libs/hscim/src/Web/Scim/Filter.hs
@@ -64,9 +64,10 @@ import Data.Aeson.Text as Aeson
 import Data.Attoparsec.ByteString.Char8
 import Data.Scientific
 import Data.String
-import Data.Text (Text, isInfixOf, isPrefixOf, isSuffixOf, pack)
+import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
-import Data.Text.Lazy (toStrict)
+import qualified Data.Text.Lazy as LT
+import Imports
 import Lens.Micro
 import Web.HttpApiData
 import Web.Scim.AttrName
@@ -165,7 +166,7 @@ topLevelAttrPath x = AttrPath Nothing (AttrName x) Nothing
 -- lift an Attoparsec parser (from Aeson) to Megaparsec
 parseFilter :: [Schema] -> Text -> Either Text Filter
 parseFilter supportedSchemas =
-  over _Left pack
+  over _Left T.pack
     . parseOnly (skipSpace *> pFilter supportedSchemas <* skipSpace <* endOfInput)
     . encodeUtf8
 
@@ -253,8 +254,8 @@ rCompValue = \case
   ValNull -> "null"
   ValBool True -> "true"
   ValBool False -> "false"
-  ValNumber n -> toStrict $ Aeson.encodeToLazyText (Aeson.Number n)
-  ValString s -> toStrict $ Aeson.encodeToLazyText (Aeson.String s)
+  ValNumber n -> LT.toStrict $ Aeson.encodeToLazyText (Aeson.Number n)
+  ValString s -> LT.toStrict $ Aeson.encodeToLazyText (Aeson.String s)
 
 -- | Comparison operator renderer.
 rCompareOp :: CompareOp -> Text
@@ -274,9 +275,9 @@ compareStr :: CompareOp -> Text -> Text -> Bool
 compareStr = \case
   OpEq -> (==) -- equal
   OpNe -> (/=) -- not equal
-  OpCo -> flip isInfixOf -- A contains B
-  OpSw -> flip isPrefixOf -- A starts with B
-  OpEw -> flip isSuffixOf -- A ends with B
+  OpCo -> flip T.isInfixOf -- A contains B
+  OpSw -> flip T.isPrefixOf -- A starts with B
+  OpEw -> flip T.isSuffixOf -- A ends with B
   OpGt -> (>) -- greater than
   OpGe -> (>=) -- greater than or equal to
   OpLt -> (<) -- less than
@@ -291,3 +292,9 @@ instance FromHttpApiData Filter where
 
 instance ToHttpApiData Filter where
   toUrlPiece = renderFilter
+
+instance ToJSON AttrPath where
+  toJSON = toJSON . rAttrPath
+
+instance FromJSON AttrPath where
+  parseJSON val = parseJSON @Text val >>= either fail pure . parseOnly (pAttrPath []) . encodeUtf8
diff --git a/libs/hscim/test/Test/FilterSpec.hs b/libs/hscim/test/Test/FilterSpec.hs
index 9fc6588e7f..44d7f2cfff 100644
--- a/libs/hscim/test/Test/FilterSpec.hs
+++ b/libs/hscim/test/Test/FilterSpec.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -19,11 +20,15 @@
 
 module Test.FilterSpec where
 
-import Data.Text (Text, cons)
+import Data.Aeson
+import qualified Data.Attoparsec.ByteString as Atto
+import Data.Text (cons)
+import Data.Text.Encoding (encodeUtf8)
 import HaskellWorks.Hspec.Hedgehog
 import Hedgehog
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
+import Imports
 import Test.Hspec
 import Web.Scim.AttrName
 import Web.Scim.Filter
@@ -39,9 +44,268 @@ prop_roundtrip = property $ do
 
 spec :: Spec
 spec = do
+  describe "AttrPath" $ do
+    describe "golden" $ do
+      let examples :: [(String, Either String AttrPath)]
+          examples =
+            [ ( "members",
+                Right $ AttrPath Nothing (AttrName "members") Nothing
+              ),
+              ( "name.familyname",
+                Right $ AttrPath Nothing (AttrName "name") (Just (SubAttr (AttrName "familyname")))
+              ),
+              ( "",
+                Left "Error in $: letter_ascii: not enough input" -- FUTUREWORK: better error
+              ),
+              ( ".members",
+                Left "Error in $: letter_ascii: Failed reading: satisfyWith" -- FUTUREWORK: better error
+              ),
+              ( "urn:ietf:params:scim:schemas:core:2.0:Group:members",
+                -- FUTUREWORK: this must be `Right $ AttrPath (Just
+                -- Group20) (AttrName "members") Nothing` (or, more
+                -- likely, be rejected due to schema not being passed
+                -- to parser)
+                Right $ AttrPath Nothing (AttrName "urn") Nothing
+              ),
+              ( "urn:ietf:params:scim:schemas:core:2.0:Group:nosuchfield",
+                -- FUTUREWORK: this must be `Left "..."`
+                Right $ AttrPath Nothing (AttrName "urn") Nothing
+              )
+            ]
+
+          runGolden :: forall a. (HasCallStack, Eq a, Show a, FromJSON a) => (String, Either String a) -> Spec
+          runGolden (ex, want) = it ("attribute path: " <> show ex) $ eitherDecode @a (encode ex) `shouldBe` want
+
+      for_ examples runGolden
+
+    describe "Rendering" $ do
+      it "renders simple attribute without schema" $ do
+        rAttrPath (AttrPath Nothing "userName" Nothing) `shouldBe` "userName"
+
+      it "renders attribute with subAttr" $ do
+        rAttrPath (AttrPath Nothing "name" (Just (SubAttr "familyName"))) `shouldBe` "name.familyName"
+
+      it "renders fully qualified attribute with schema" $ do
+        rAttrPath (AttrPath (Just User20) "userName" Nothing)
+          `shouldBe` "urn:ietf:params:scim:schemas:core:2.0:User:userName"
+
+      it "renders fully qualified attribute with schema and subAttr" $ do
+        rAttrPath (AttrPath (Just User20) "name" (Just (SubAttr "familyName")))
+          `shouldBe` "urn:ietf:params:scim:schemas:core:2.0:User:name.familyName"
+
+    describe "Multiple schemas" $ do
+      it "can parse filter with Group20 schema when supported" $ do
+        parseFilter [User20, Group20] "urn:ietf:params:scim:schemas:core:2.0:Group:displayName eq \"Admins\""
+          `shouldBe` Right (FilterAttrCompare (AttrPath (Just Group20) "displayName" Nothing) OpEq (ValString "Admins"))
+
+      it "fails to parse unsupported schema" $ do
+        parseFilter [User20] "urn:ietf:params:scim:schemas:core:2.0:Group:displayName eq \"Admins\""
+          `shouldSatisfy` isLeft
+
+  describe "ValuePath" $ do
+    describe "golden" $ do
+      it "renders ValuePath correctly" $ do
+        let valuePath =
+              ValuePath
+                (AttrPath Nothing "addresses" Nothing)
+                (FilterAttrCompare (AttrPath Nothing "type" Nothing) OpEq (ValString "work"))
+        rValuePath valuePath `shouldBe` "addresses[type eq \"work\"]"
+
+      it "renders ValuePath with schema prefix" $ do
+        let valuePath =
+              ValuePath
+                (AttrPath (Just User20) "emails" Nothing)
+                (FilterAttrCompare (AttrPath Nothing "primary" Nothing) OpEq (ValBool True))
+        rValuePath valuePath `shouldBe` "urn:ietf:params:scim:schemas:core:2.0:User:emails[primary eq true]"
+
+      it "renders ValuePath with subAttr filter correctly" $ do
+        let valuePath =
+              ValuePath
+                (AttrPath Nothing "members" Nothing)
+                (FilterAttrCompare (AttrPath Nothing "value" Nothing) OpEq (ValString "user123"))
+        rValuePath valuePath `shouldBe` "members[value eq \"user123\"]"
+
+      -- FUTUREWORK
+      let examples :: [(Text, Either String ValuePath)]
+          examples =
+            [ ( "addresses[type eq \"work\"]",
+                Right $
+                  ValuePath
+                    (AttrPath Nothing (AttrName "addresses") Nothing)
+                    (mkFilter "type" OpEq "work")
+              ),
+              ( "members[value eq \"2819c223-7f76-453a-919d-413861904646\"]",
+                Right $
+                  ValuePath
+                    (AttrPath Nothing (AttrName "members") Nothing)
+                    (mkFilter "value" OpEq "2819c223-7f76-453a-919d-413861904646")
+              )
+              {- FUTUREWORK: these tests fail (not implemented)
+
+              ( "members[type eq \"work\"].displayname",
+                Right $
+                  ValuePath
+                    (AttrPath Nothing (AttrName "members") (Just (SubAttr (AttrName "displayname"))))
+                    (mkFilter "type" OpEq "work")
+              ),
+              ( "members[type le \"work\" and value eq \"\"]",
+                Right $
+                  ValuePath
+                    (AttrPath Nothing (AttrName "members") Nothing)
+                    (mkFilter "type" OpLe "work")
+              )
+              -}
+            ]
+
+          mkFilter :: Text -> CompareOp -> Text -> Filter
+          mkFilter field co val = FilterAttrCompare (AttrPath Nothing (AttrName field) Nothing) co (ValString val)
+
+      for_ examples $ \(str, want) ->
+        it ("value path: " <> show str) $
+          Atto.parseOnly (pValuePath [User20]) (encodeUtf8 str) `shouldBe` want
+
   describe "Filter" $ do
     it "parse . render === id" $ require $ prop_roundtrip @(TestTag Text () () NoUserExtra)
 
+    describe "golden" $ do
+      it "1" $ do
+        parseFilter [] ""
+          `shouldBe` Left "letter_ascii: not enough input" -- FUTUREWORK: better error
+        parseFilter [User20] ""
+          `shouldBe` Left "letter_ascii: not enough input" -- FUTUREWORK: better error
+      it "2" $ do
+        parseFilter [] "nosuchfield co \"yessuchfield\""
+          `shouldBe` Right (FilterAttrCompare (AttrPath Nothing "nosuchfield" Nothing) OpCo (ValString "yessuchfield"))
+      it "3" $ do
+        parseFilter [] ".nosuchfield eq "
+          `shouldBe` Left "letter_ascii: Failed reading: satisfyWith" -- FUTUREWORK: better error
+      it "4" $ do
+        parseFilter [] "attr.subAttr eq \"stuff\""
+          `shouldBe` Right
+            ( FilterAttrCompare
+                (AttrPath Nothing (AttrName "attr") (Just (SubAttr (AttrName "subAttr"))))
+                OpEq
+                (ValString "stuff")
+            )
+
+    describe "Comparison operators and CompValue types" $ do
+      let filterExamples :: [(Text, Either Text Filter)]
+          filterExamples =
+            [ -- OpEq tests
+              ( "userName eq \"john\"",
+                Right $ FilterAttrCompare (AttrPath Nothing "userName" Nothing) OpEq (ValString "john")
+              ),
+              ( "age eq 42",
+                Right $ FilterAttrCompare (AttrPath Nothing "age" Nothing) OpEq (ValNumber 42)
+              ),
+              ( "active eq true",
+                Right $ FilterAttrCompare (AttrPath Nothing "active" Nothing) OpEq (ValBool True)
+              ),
+              ( "active eq false",
+                Right $ FilterAttrCompare (AttrPath Nothing "active" Nothing) OpEq (ValBool False)
+              ),
+              ( "manager eq null",
+                Right $ FilterAttrCompare (AttrPath Nothing "manager" Nothing) OpEq ValNull
+              ),
+              -- OpNe tests
+              ( "userName ne \"john\"",
+                Right $ FilterAttrCompare (AttrPath Nothing "userName" Nothing) OpNe (ValString "john")
+              ),
+              -- OpCo (contains) test
+              ( "userName co \"john\"",
+                Right $ FilterAttrCompare (AttrPath Nothing "userName" Nothing) OpCo (ValString "john")
+              ),
+              -- OpSw (starts with) test
+              ( "userName sw \"john\"",
+                Right $ FilterAttrCompare (AttrPath Nothing "userName" Nothing) OpSw (ValString "john")
+              ),
+              -- OpEw (ends with) test
+              ( "userName ew \"john\"",
+                Right $ FilterAttrCompare (AttrPath Nothing "userName" Nothing) OpEw (ValString "john")
+              ),
+              -- OpGt test
+              ( "age gt 18",
+                Right $ FilterAttrCompare (AttrPath Nothing "age" Nothing) OpGt (ValNumber 18)
+              ),
+              -- OpGe test
+              ( "age ge 18",
+                Right $ FilterAttrCompare (AttrPath Nothing "age" Nothing) OpGe (ValNumber 18)
+              ),
+              -- OpLt test
+              ( "age lt 65",
+                Right $ FilterAttrCompare (AttrPath Nothing "age" Nothing) OpLt (ValNumber 65)
+              ),
+              -- OpLe test
+              ( "age le 65",
+                Right $ FilterAttrCompare (AttrPath Nothing "age" Nothing) OpLe (ValNumber 65)
+              ),
+              -- Decimal number
+              ( "score eq 3.14",
+                Right $ FilterAttrCompare (AttrPath Nothing "score" Nothing) OpEq (ValNumber 3.14)
+              ),
+              -- Error cases
+              ( "userName eq",
+                Left "space: not enough input" -- FUTUREWORK: better error
+              ),
+              ( "userName \"john\"",
+                Left "Failed reading: empty" -- FUTUREWORK: better error
+              ),
+              ( "",
+                Left "letter_ascii: not enough input" -- FUTUREWORK: better error
+              ),
+              ( "   ",
+                Left "letter_ascii: not enough input" -- FUTUREWORK: better error
+              )
+            ]
+
+      for_ filterExamples $ \(filterStr, want) ->
+        it ("filter: " <> show filterStr) $
+          parseFilter [User20] filterStr `shouldBe` want
+
+    describe "AttrPath inside Filter" $ do
+      describe "Parsing and rendering" $
+        do
+          let attrPathExamples :: [(Text, Either Text Filter)]
+              attrPathExamples =
+                [ -- Simple attribute without schema
+                  ( "userName eq \"john\"",
+                    Right $ FilterAttrCompare (AttrPath Nothing "userName" Nothing) OpEq (ValString "john")
+                  ),
+                  -- Attribute with subAttr
+                  ( "name.familyName eq \"Doe\"",
+                    Right $ FilterAttrCompare (AttrPath Nothing "name" (Just (SubAttr "familyName"))) OpEq (ValString "Doe")
+                  ),
+                  -- Fully qualified with User20 schema
+                  ( "urn:ietf:params:scim:schemas:core:2.0:User:userName eq \"john\"",
+                    Right $ FilterAttrCompare (AttrPath (Just User20) "userName" Nothing) OpEq (ValString "john")
+                  ),
+                  -- Fully qualified with schema and subAttr
+                  ( "urn:ietf:params:scim:schemas:core:2.0:User:name.familyName eq \"Doe\"",
+                    Right $ FilterAttrCompare (AttrPath (Just User20) "name" (Just (SubAttr "familyName"))) OpEq (ValString "Doe")
+                  ),
+                  {- FUTUREWORK: this fails
+
+                  -- Custom schema
+                  ( "urn:hscim:test:customAttr eq \"value\"",
+                    Right $ FilterAttrCompare (AttrPath (Just (CustomSchema "urn:hscim:test")) "customAttr" Nothing) OpEq (ValString "value")
+                  ),
+                  -}
+                  -- Error case - unsupported schema (Group20 not in supported schemas for User20-only list)
+                  ( "urn:ietf:params:scim:schemas:core:2.0:Group:displayName eq \"Admins\"",
+                    Left "space: Failed reading: satisfyWith" -- FUTUREWORK: better error
+                  ),
+                  ( "",
+                    Left "letter_ascii: not enough input" -- FUTUREWORK: better error
+                  ),
+                  ( ".userName eq \"test\"",
+                    Left "letter_ascii: Failed reading: satisfyWith" -- FUTUREWORK: better error
+                  )
+                ]
+
+          for_ attrPathExamples $ \(str, want) ->
+            it ("filter: " <> show str) $
+              parseFilter [User20] str `shouldBe` want
+
 ----------------------------------------------------------------------------
 -- Generators
 

From 2b1432fc11910e7d15c0bd67a41a39bb31132727 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 23 Dec 2025 12:55:37 +0100
Subject: [PATCH 06/13] Cleanup code, add FUTUREWORK.

---
 libs/hscim/src/Web/Scim/Filter.hs      | 28 ++++++++++++++++----------
 libs/hscim/test/Test/Class/UserSpec.hs |  6 +++---
 2 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/libs/hscim/src/Web/Scim/Filter.hs b/libs/hscim/src/Web/Scim/Filter.hs
index 35aa2353ed..c09f66bff7 100644
--- a/libs/hscim/src/Web/Scim/Filter.hs
+++ b/libs/hscim/src/Web/Scim/Filter.hs
@@ -120,6 +120,23 @@ data CompareOp
 -- more complex filters
 --
 -- FILTER    = attrExp / logExp / valuePath / *1"not" "(" FILTER ")"
+-- PATH = attrPath / valuePath [subAttr]
+--
+-- FUTUREWORK(fisx): Currently we don't support matching on lists in paths
+-- as we currently don't support filtering on arbitrary attributes yet
+-- e.g.
+-- @
+-- "path":"members[value eq
+--            \"2819c223-7f76-453a-919d-413861904646\"].displayName"
+-- @
+-- is not supported. The code here should actually read something like this:
+-- @
+-- data Filter = FilterAttrCompare (Either AttrPath ValuePath) CompareOp CompValue
+-- @
+--
+-- FUTUREWORK(fisx): does it make sense to have a type-level argument to
+-- AttrPath, ValuePath(?), Filter containing the allowed schemas?
+-- it's certainly information that should be known at compile time...
 data Filter
   = -- | Compare the attribute value with a literal
     FilterAttrCompare AttrPath CompareOp CompValue
@@ -144,17 +161,6 @@ data AttrPath = AttrPath (Maybe Schema) AttrName (Maybe SubAttr)
 topLevelAttrPath :: Text -> AttrPath
 topLevelAttrPath x = AttrPath Nothing (AttrName x) Nothing
 
--- | PATH = attrPath / valuePath [subAttr]
---
--- Currently we don't support matching on lists in paths as
--- we currently don't support filtering on arbitrary attributes yet
--- e.g.
--- @
--- "path":"members[value eq
---            \"2819c223-7f76-453a-919d-413861904646\"].displayName"
--- @
--- is not supported
-
 ----------------------------------------------------------------------------
 -- Parsing
 
diff --git a/libs/hscim/test/Test/Class/UserSpec.hs b/libs/hscim/test/Test/Class/UserSpec.hs
index 6a46738dcc..de3f77a37a 100644
--- a/libs/hscim/test/Test/Class/UserSpec.hs
+++ b/libs/hscim/test/Test/Class/UserSpec.hs
@@ -363,9 +363,9 @@ spec = with app $ do
         patch
           "/0"
           [scim|{
-          "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-          "Operations": [{ "op": "Remove", "path": "displayName"}]
-        }|]
+            "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+            "operations": [{ "op": "remove", "path": "displayName"}]
+          }|]
           `shouldRespondWith` [scim|{
           "schemas": [
             "urn:ietf:params:scim:schemas:core:2.0:User"

From 0f334d94cd3427be8916893e5510e919bffe82e8 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 23 Dec 2025 13:56:07 +0100
Subject: [PATCH 07/13] Refactor `PatchOp` type. [WIP]

The old class `Patchable` mixes concerns of validation and patch
application. We take this apart into
- validate schemas based on aeson-schema
- compile patch into aeson-diff syntax and apply that instead of
  implementing our own code for that

Also Patchable is restricted to `User`, and the new code allows for
patching Users, Groups, extension schemas, and potentially other
stuff.

In detail, the following changes are made in this commit:
- `PatchOp` makes more illegal states unrepresentable with `PatchOp`
  instead of `Operation`;
- `Web.Scim.Filter` is used, not re-invented;
- replace `Patchable` class with `SupportsSchemas`;
- re-implement `applyPatch` based on these changes;
- more haddocs.
---
 libs/hscim/default.nix                      |   1 +
 libs/hscim/src/Web/Scim/Class/Group.hs      |   3 +-
 libs/hscim/src/Web/Scim/Class/User.hs       |   2 +-
 libs/hscim/src/Web/Scim/Client.hs           |   2 +
 libs/hscim/src/Web/Scim/Filter.hs           |   2 +
 libs/hscim/src/Web/Scim/Schema/Schema.hs    |  15 +-
 libs/hscim/src/Web/Scim/Schema/User.hs      |  95 +--------
 libs/hscim/src/Web/Scim/Schema/UserTypes.hs |   9 +-
 libs/hscim/src/Web/Scim/Server/Mock.hs      |   7 +-
 libs/hscim/src/Web/Scim/Test/Util.hs        |   7 +-
 libs/hscim/test/Test/Schema/PatchOpSpec.hs  | 219 ++++++++++----------
 libs/hscim/test/Test/Schema/UserSpec.hs     |   8 +-
 12 files changed, 150 insertions(+), 220 deletions(-)

diff --git a/libs/hscim/default.nix b/libs/hscim/default.nix
index f906963c17..3ff763e9a1 100644
--- a/libs/hscim/default.nix
+++ b/libs/hscim/default.nix
@@ -116,6 +116,7 @@ mkDerivation {
     aeson
     aeson-diff
     aeson-qq
+    attoparsec
     base
     bytestring
     email-validate
diff --git a/libs/hscim/src/Web/Scim/Class/Group.hs b/libs/hscim/src/Web/Scim/Class/Group.hs
index 16ef2d0140..9336509278 100644
--- a/libs/hscim/src/Web/Scim/Class/Group.hs
+++ b/libs/hscim/src/Web/Scim/Class/Group.hs
@@ -41,6 +41,7 @@ import Web.Scim.Handler
 import Web.Scim.Schema.Common
 import Web.Scim.Schema.ListResponse
 import Web.Scim.Schema.Meta
+import qualified Web.Scim.Schema.Schema as S
 
 ----------------------------------------------------------------------------
 -- /Groups API
@@ -48,7 +49,7 @@ import Web.Scim.Schema.Meta
 type Schema = Text
 
 -- | Configurable parts of 'Group'.
-class GroupTypes tag where
+class (S.SupportsSchemas tag) => GroupTypes tag where
   -- | Group ID type.
   type GroupId tag
 
diff --git a/libs/hscim/src/Web/Scim/Class/User.hs b/libs/hscim/src/Web/Scim/Class/User.hs
index 982ad3700e..dd0feed872 100644
--- a/libs/hscim/src/Web/Scim/Class/User.hs
+++ b/libs/hscim/src/Web/Scim/Class/User.hs
@@ -67,7 +67,7 @@ data UserSite tag route = UserSite
       route
         :- Capture "id" (UserId tag)
           :> ReqBody '[SCIM] (PatchOp tag)
-          :> Patch '[SCIM] (StoredUser tag),
+          :> Servant.Patch '[SCIM] (StoredUser tag),
     usDeleteUser ::
       route
         :- Capture "id" (UserId tag)
diff --git a/libs/hscim/src/Web/Scim/Client.hs b/libs/hscim/src/Web/Scim/Client.hs
index c80070fb03..4fea65778f 100644
--- a/libs/hscim/src/Web/Scim/Client.hs
+++ b/libs/hscim/src/Web/Scim/Client.hs
@@ -59,12 +59,14 @@ import Web.Scim.Filter (Filter)
 import Web.Scim.Schema.ListResponse (ListResponse)
 import Web.Scim.Schema.PatchOp (PatchOp)
 import qualified Web.Scim.Schema.ResourceType as ResourceType
+import Web.Scim.Schema.Schema
 import Web.Scim.Schema.User (User)
 import Web.Scim.Schema.UserTypes (UserExtra, UserId)
 import Web.Scim.Server
 
 type HasScimClient tag =
   ( AuthTypes tag,
+    SupportsSchemas tag,
     ToJSON (UserExtra tag),
     FromJSON (UserExtra tag),
     FromJSON (UserId tag),
diff --git a/libs/hscim/src/Web/Scim/Filter.hs b/libs/hscim/src/Web/Scim/Filter.hs
index c09f66bff7..52b57ace82 100644
--- a/libs/hscim/src/Web/Scim/Filter.hs
+++ b/libs/hscim/src/Web/Scim/Filter.hs
@@ -137,6 +137,8 @@ data CompareOp
 -- FUTUREWORK(fisx): does it make sense to have a type-level argument to
 -- AttrPath, ValuePath(?), Filter containing the allowed schemas?
 -- it's certainly information that should be known at compile time...
+--
+-- https://datatracker.ietf.org/doc/html/rfc7644#section-3.4.2.2
 data Filter
   = -- | Compare the attribute value with a literal
     FilterAttrCompare AttrPath CompareOp CompValue
diff --git a/libs/hscim/src/Web/Scim/Schema/Schema.hs b/libs/hscim/src/Web/Scim/Schema/Schema.hs
index d7ae67016c..2339429d13 100644
--- a/libs/hscim/src/Web/Scim/Schema/Schema.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Schema.hs
@@ -20,6 +20,8 @@ module Web.Scim.Schema.Schema where
 import Data.Aeson (FromJSON, ToJSON, Value, parseJSON, toJSON, withText)
 import Data.Attoparsec.ByteString (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as Parser
+import Data.Data (Proxy)
+import Data.Set (Set)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Web.Scim.Capabilities.MetaSchema.Group
@@ -39,7 +41,7 @@ data Schema
   | Error20
   | PatchOp20
   | CustomSchema Text
-  deriving (Show, Eq)
+  deriving (Show, Eq, Ord)
 
 -- | 'Schema' is *almost* a straight-forward enum type, except for 'CustomSchema'.
 -- Enumerations are nice because they let you write quickcheck generators as @elements
@@ -95,9 +97,9 @@ getSchemaUri (CustomSchema x) =
 -- NOTE: according to the spec, this parser needs to be case insensitive, but
 -- that is literally insane. Won't implement.
 pSchema :: [Schema] -> Parser Schema
-pSchema supportedSchemas =
-  Parser.choice $
-    map (\s -> fromSchemaUri . decodeUtf8 <$> Parser.string (encodeUtf8 $ getSchemaUri s)) supportedSchemas
+pSchema supported =
+  Parser.choice
+    $ map (\s -> fromSchemaUri . decodeUtf8 <$> Parser.string (encodeUtf8 $ getSchemaUri s)) supported
 
 -- | Get a schema by its URI.
 --
@@ -152,3 +154,8 @@ getSchema PatchOp20 =
 -- FUTUREWORK: allow supplying schemas for 'CustomSchema'.
 getSchema (CustomSchema _) =
   Nothing
+
+class SupportsSchemas a where
+  -- | Schemas supported by the the tagged type. API clients touching
+  -- fields not contained in the listed schemas triggers error 4xx.
+  supportedSchemas :: Proxy a -> Set Schema
diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs
index 1a37f6dae6..9a97468e25 100644
--- a/libs/hscim/src/Web/Scim/Schema/User.hs
+++ b/libs/hscim/src/Web/Scim/Schema/User.hs
@@ -64,7 +64,6 @@ module Web.Scim.Schema.User
   ( User (..),
     empty,
     NoUserExtra (..),
-    applyPatch,
     resultToScimError,
     isUserSchema,
     module Web.Scim.Schema.UserTypes,
@@ -183,6 +182,9 @@ instance (FromJSON (UserExtra tag)) => FromJSON (User tag) where
     -- Lowercase all fields
     let o = KeyMap.fromList . map (over _1 lowerKey) . KeyMap.toList $ obj
     schemas <-
+      -- TODO(fisx): NO! User20 is NOT implicit?
+      -- https://datatracker.ietf.org/doc/html/rfc7643#section-3
+      -- (Also make sure this works as expected in Group!)
       o .:? "schemas" <&> \case
         Nothing -> [User20]
         Just xs -> if User20 `elem` xs then xs else User20 : xs
@@ -262,102 +264,13 @@ instance FromJSON NoUserExtra where
 instance ToJSON NoUserExtra where
   toJSON _ = object []
 
-instance Patchable NoUserExtra where
-  applyOperation _ _ = throwError $ badRequest InvalidValue (Just "there are no user extra attributes to patch")
-
 ----------------------------------------------------------------------------
 -- Applying
 
--- | Applies a JSON Patch to a SCIM Core User
--- Only supports the core attributes.
--- Evenmore, only some hand-picked ones currently.
--- We'll have to think how patch is going to work in the presence of extensions.
--- Also, we can probably make  PatchOp type-safe to some extent (Read arianvp's thesis :))
-applyPatch ::
-  ( Patchable (UserExtra tag),
-    FromJSON (UserExtra tag),
-    MonadError ScimError m,
-    UserTypes tag
-  ) =>
-  User tag ->
-  PatchOp tag ->
-  m (User tag)
-applyPatch = (. getOperations) . foldM applyOperation
-
 resultToScimError :: (MonadError ScimError m) => Result a -> m a
 resultToScimError (Error reason) = throwError $ badRequest InvalidValue (Just (pack reason))
 resultToScimError (Success a) = pure a
 
--- TODO(arianvp): support multi-valued and complex attributes.
--- TODO(arianvp): Actually do this in some kind of type-safe way. e.g.
--- have a UserPatch type.
---
--- What I understand from the spec:  The difference between add an replace is only
--- in the fact that replace will not concat multi-values, and behaves differently for complex values too.
--- For simple attributes, add and replace are identical.
-applyUserOperation ::
-  forall m tag.
-  ( UserTypes tag,
-    FromJSON (User tag),
-    Patchable (UserExtra tag),
-    MonadError ScimError m
-  ) =>
-  User tag ->
-  Operation ->
-  m (User tag)
-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
-    "username" ->
-      (\x -> user {userName = x}) <$> resultToScimError (fromJSON value)
-    "displayname" ->
-      (\x -> user {displayName = x}) <$> resultToScimError (fromJSON value)
-    "externalid" ->
-      (\x -> user {externalId = x}) <$> resultToScimError (fromJSON value)
-    "active" ->
-      (\x -> user {active = x}) <$> resultToScimError (fromJSON value)
-    "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", "roles"]) -> do
-      (u :: User tag) <- resultToScimError $ fromJSON value
-      pure $
-        user
-          { userName = userName u,
-            displayName = displayName u,
-            externalId = externalId u,
-            active = active u
-          }
-    _ -> 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)
-applyUserOperation user (Operation Remove (Just (NormalPath (AttrPath _schema attr _subAttr))) _value) =
-  case attr of
-    "username" -> throwError (badRequest Mutability Nothing)
-    "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"))
-
-instance (UserTypes tag, FromJSON (User tag), Patchable (UserExtra tag)) => Patchable (User tag) where
-  applyOperation user op@(Operation _ (Just (NormalPath (AttrPath schema _ _))) _)
-    | isUserSchema schema = applyUserOperation user op
-    | isSupportedCustomSchema schema = (\x -> user {extra = x}) <$> applyOperation (extra user) op
-    | otherwise =
-        throwError $ badRequest InvalidPath $ Just $ "we only support these schemas: " <> Text.intercalate ", " (map getSchemaUri (supportedSchemas @tag))
-    where
-      isSupportedCustomSchema = maybe False (`elem` supportedSchemas @tag)
-  applyOperation user op = applyUserOperation user op
-
--- Omission of a schema for users is implicitly the core schema
--- TODO(arianvp): Link to part of the spec that claims this.
+-- TODO(fisx): BUG: schema field is always required!  https://datatracker.ietf.org/doc/html/rfc7643#section-6
 isUserSchema :: Maybe Schema -> Bool
 isUserSchema = maybe True (== User20)
diff --git a/libs/hscim/src/Web/Scim/Schema/UserTypes.hs b/libs/hscim/src/Web/Scim/Schema/UserTypes.hs
index 904955cc7e..46b698037a 100644
--- a/libs/hscim/src/Web/Scim/Schema/UserTypes.hs
+++ b/libs/hscim/src/Web/Scim/Schema/UserTypes.hs
@@ -19,17 +19,12 @@
 
 module Web.Scim.Schema.UserTypes where
 
-import Web.Scim.Schema.Schema (Schema)
+import Web.Scim.Schema.Schema
 
 -- | Configurable parts of 'User'.
-class UserTypes tag where
+class (SupportsSchemas tag) => UserTypes tag where
   -- | User ID type.
   type UserId tag
 
   -- | Extra data carried with each 'User'.
   type UserExtra tag
-
-  -- | Schemas supported by the 'User' for filtering and patching.
-  --
-  -- This must include User20, this is not checked.
-  supportedSchemas :: [Schema]
diff --git a/libs/hscim/src/Web/Scim/Server/Mock.hs b/libs/hscim/src/Web/Scim/Server/Mock.hs
index 3b819c1662..a0785498ae 100644
--- a/libs/hscim/src/Web/Scim/Server/Mock.hs
+++ b/libs/hscim/src/Web/Scim/Server/Mock.hs
@@ -35,6 +35,7 @@ import Data.Hashable
 import Data.Maybe (fromMaybe)
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
 import Data.Text (Text, pack)
 import Data.Time.Calendar
 import Data.Time.Clock
@@ -55,7 +56,7 @@ import Web.Scim.Schema.Error
 import Web.Scim.Schema.ListResponse
 import Web.Scim.Schema.Meta
 import Web.Scim.Schema.ResourceType
-import Web.Scim.Schema.Schema (Schema (Group20, ListResponse20, User20))
+import Web.Scim.Schema.Schema
 import Web.Scim.Schema.User hiding (displayName)
 
 -- | Tag used in the mock server.
@@ -106,7 +107,9 @@ hoistSTM = hoist liftSTM
 instance UserTypes Mock where
   type UserId Mock = Id
   type UserExtra Mock = NoUserExtra
-  supportedSchemas = [User20]
+
+instance SupportsSchemas Mock where
+  supportedSchemas _ = Set.fromList [User20]
 
 instance UserDB Mock TestServer where
   getUsers () mbFilter = do
diff --git a/libs/hscim/src/Web/Scim/Test/Util.hs b/libs/hscim/src/Web/Scim/Test/Util.hs
index d4ef837eee..2e706a3938 100644
--- a/libs/hscim/src/Web/Scim/Test/Util.hs
+++ b/libs/hscim/src/Web/Scim/Test/Util.hs
@@ -62,6 +62,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BS8
 import qualified Data.ByteString.Lazy as L
 import Data.Proxy
+import qualified Data.Set as Set
 import Data.Text hiding (show)
 import Data.UUID as UUID
 import Data.UUID.V4 as UUID
@@ -76,7 +77,7 @@ import Test.Hspec.Wai hiding (patch, post, put, shouldRespondWith)
 import Test.Hspec.Wai.Matcher (bodyEquals, match)
 import Web.Scim.Class.Auth (AuthTypes (..))
 import Web.Scim.Class.Group (GroupTypes (..))
-import Web.Scim.Schema.Schema (Schema (CustomSchema, User20))
+import Web.Scim.Schema.Schema
 import Web.Scim.Schema.User (UserTypes (..))
 
 -- | re-implementation of 'shouldRespondWith' with better error reporting.
@@ -254,7 +255,9 @@ data TestTag id authData authInfo userExtra
 instance UserTypes (TestTag id authData authInfo userExtra) where
   type UserId (TestTag id authData authInfo userExtra) = id
   type UserExtra (TestTag id authData authInfo userExtra) = userExtra
-  supportedSchemas = [User20, CustomSchema "urn:hscim:test"]
+
+instance SupportsSchemas (TestTag id authData authInfo userExtra) where
+  supportedSchemas _ = Set.fromList [User20, CustomSchema "urn:hscim:test"]
 
 instance GroupTypes (TestTag id authData authInfo userExtra) where
   type GroupId (TestTag id authData authInfo userExtra) = id
diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
index 2e9a041531..bfc0735a5d 100644
--- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs
+++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -20,123 +22,122 @@
 
 module Test.Schema.PatchOpSpec where
 
-import qualified Data.Aeson as Aeson
+import Data.Aeson
+import qualified Data.Aeson.Diff as AD
 import qualified Data.Aeson.KeyMap as KeyMap
-import Data.Aeson.Types (Result (Error, Success), Value (String), fromJSON, toJSON)
-import qualified Data.Aeson.Types as Aeson
-import Data.Attoparsec.ByteString (parseOnly)
-import Data.Either (isLeft)
-import Data.Foldable (for_)
-import Data.Text (Text)
-import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-import HaskellWorks.Hspec.Hedgehog (require)
-import Hedgehog (Gen, Property, forAll, property, tripping)
-import qualified Hedgehog.Gen as Gen
-import qualified Hedgehog.Range as Range
-import Test.FilterSpec (genAttrPath, genSubAttr, genValuePath)
-import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy, xit)
-import Test.Schema.Util (mk_prop_caseInsensitive)
-import Web.Scim.AttrName (AttrName (..))
-import Web.Scim.Filter (AttrPath (..), CompValue (ValNull), CompareOp (OpEq), Filter (..), ValuePath (..))
+import qualified Data.Aeson.Pointer as AD
+import Data.Aeson.QQ (aesonQQ)
+import Data.Aeson.Types
+import Data.Either
+import qualified Data.List.NonEmpty as NE
+import Imports
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+import Web.Scim.Filter
 import Web.Scim.Schema.PatchOp
-import Web.Scim.Schema.Schema (Schema (User20))
-import Web.Scim.Schema.User (UserTypes)
-import Web.Scim.Schema.UserTypes (supportedSchemas)
-import Web.Scim.Test.Util (TestTag, scim)
+import Web.Scim.Schema.User
+import Web.Scim.Test.Util
 
-isSuccess :: Result a -> Bool
-isSuccess (Success _) = True
-isSuccess (Error _) = False
+type PatchTag = TestTag Text () () UserExtraPatch
 
-genPatchOp :: forall tag. (UserTypes tag) => Gen Value -> Gen (PatchOp tag)
-genPatchOp genValue = PatchOp <$> Gen.list (Range.constant 0 20) ((genOperation @tag) genValue)
+type UserExtraPatch = KeyMap.KeyMap Text
 
-genSimplePatchOp :: forall tag. (UserTypes tag) => Gen (PatchOp tag)
-genSimplePatchOp = genPatchOp @tag (String <$> Gen.text (Range.constant 0 20) Gen.unicode)
+spec :: Spec
+spec = do
+  describe "PatchOp" $ do
+    ----------------------------------------------------------------------
 
-genOperation :: forall tag. (UserTypes tag) => Gen Value -> Gen Operation
-genOperation genValue = Operation <$> Gen.enumBounded <*> Gen.maybe (genPath @tag) <*> Gen.maybe genValue
+    it "golden + simple roundtrip" $ do
+      let check :: (PatchOp PatchTag, Value) -> Expectation
+          check (hs, js) = do
+            toJSON hs `shouldBe` js
+            case parseEither parseJSON js of
+              Left err -> expectationFailure $ "Failed to parse: " ++ err
+              Right (have :: PatchOp PatchTag) -> have `shouldBe` hs
 
-genPath :: forall tag. (UserTypes tag) => Gen Path
-genPath =
-  Gen.choice
-    [ IntoValuePath <$> (genValuePath @tag) <*> Gen.maybe genSubAttr,
-      NormalPath <$> (genAttrPath @tag)
-    ]
+      check
+        `mapM_` [ ( todo, -- PatchOp (AD.Patch []),
+                    [aesonQQ|
+                    {
+                    "schemaS": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                      "OperaTions": [{
+                        "oP": "aDD",
+                        "pATh": "userName",
+                        "vaLUE": "testuser"
+                      }]
+                    }
+                    |]
+                  )
+                ]
 
-prop_roundtrip :: forall tag. (UserTypes tag) => Property
-prop_roundtrip = property $ do
-  x <- forAll $ genPath @tag
-  tripping x (encodeUtf8 . rPath) (parseOnly $ pPath (supportedSchemas @tag))
+    -- todo "test missing path field for add, rep"
 
-prop_roundtrip_PatchOp :: forall tag. (UserTypes tag) => Property
-prop_roundtrip_PatchOp = property $ do
-  -- Just some strings for now. However, should be constrained to what the
-  -- PatchOp is operating on in the future... We need better typed PatchOp for
-  -- this. TODO(arianvp)
-  x <- forAll (genSimplePatchOp @tag)
-  tripping x toJSON fromJSON
+    it "Operation attributes and value attributes are case-insensitive" $ do
+      let patches :: [Value] =
+            [ [aesonQQ|
+              {
+                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                "Operations": [{
+                  "op": "replace",
+                  "path": "displayName",
+                  "value": "Name"
+                }]
+              }
+              |],
+              [aesonQQ|
+              {
+                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                "Operations": [{
+                  "op": "REPLACE",
+                  "path": "displayName",
+                  "value": "Name"
+                }]
+              }
+              |],
+              [aesonQQ|
+              {
+                "Schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                "Operations": [{
+                  "OP": "Replace",
+                  "PATH": "dISPlayName",
+                  "VALUE": "Name"
+                }]
+              }
+              |]
+            ]
+      case nub $ (eitherDecode @(PatchOp PatchTag) . encode) <$> patches of
+        [Right _] -> pure ()
+        bad -> expectationFailure $ "Case insensitivity check failed, the following variantions should not be distinguished: " ++ show bad
 
-type PatchTestTag = TestTag () () () ()
+  describe "applyPatch" $ do
+    prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
+      \(barbie :: User (TestTag Text () () NoUserExtra)) changedWant ->
+        let patchOp :: Patch (TestTag Text () () NoUserExtra)
+            patchOp = todo -- PatchOp (AD.diff (toJSON barbie) (toJSON changedWant))
+         in applyPatch patchOp barbie === Right changedWant
 
-spec :: Spec
-spec = do
-  describe "Patchable" $
-    describe "HashMap Text Text" $ do
-      it "supports `Add` operation" $ do
-        let theMap = KeyMap.empty @Text
-            operation = Operation Add (Just $ NormalPath (AttrPath Nothing (AttrName "key") Nothing)) $ Just "value"
-        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key" "value")
-      it "supports `Replace` operation" $ do
-        let theMap = KeyMap.singleton @Text "key" "value1"
-            operation = Operation Replace (Just $ NormalPath (AttrPath Nothing (AttrName "key") Nothing)) $ Just "value2"
-        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key" "value2")
-      it "supports `Delete` operation" $ do
-        let theMap = KeyMap.fromList @Text [("key1", "value1"), ("key2", "value2")]
-            operation = Operation Remove (Just $ NormalPath (AttrPath Nothing (AttrName "key1") Nothing)) Nothing
-        applyOperation theMap operation `shouldBe` Right (KeyMap.singleton "key2" "value2")
-      it "gracefully rejects invalid/unsupported operations" $ do
-        let theMap = KeyMap.fromList @Text [("key1", "value1"), ("key2", "value2")]
-            key1Path = AttrPath Nothing (AttrName "key1") Nothing
-            key2Path = AttrPath Nothing (AttrName "key2") Nothing
-            invalidOperations =
-              [ Operation Add (Just $ NormalPath key1Path) Nothing, -- Nothing to add
-                Operation Replace (Just $ NormalPath key1Path) Nothing, -- Nothing to replace
-                Operation Add (Just $ IntoValuePath (ValuePath key1Path (FilterAttrCompare key2Path OpEq ValNull)) Nothing) Nothing
-                -- IntoValuePaths don't make sense for HashMap Text Text
-              ]
-        mapM_ (\o -> applyOperation theMap o `shouldSatisfy` isLeft) invalidOperations
-  describe "urn:ietf:params:scim:api:messages:2.0:PatchOp" $ do
-    describe "The body of each request MUST contain the \"schemas\" attribute with the URI value of \"urn:ietf:params:scim:api:messages:2.0:PatchOp\"." $
-      it "rejects an empty schemas list" $ do
-        fromJSON @(PatchOp PatchTestTag)
-          [scim| {
-          "schemas": [],
-          "operations": []
-        }|]
-          `shouldSatisfy` (not . isSuccess)
-    -- TODO(arianvp): We don't support arbitrary path names (yet)
-    it "roundtrips Path" $ require $ prop_roundtrip @PatchTestTag
-    it "roundtrips PatchOp" $ require $ prop_roundtrip_PatchOp @PatchTestTag
-    it "case-insensitive" $ require $ mk_prop_caseInsensitive (genSimplePatchOp @PatchTestTag)
-    it "rejects invalid operations" $
-      fromJSON @(PatchOp PatchTestTag)
-        [scim| {
-          "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-          "operations": [{"op":"unknown"}]
-      }|]
-        `shouldSatisfy` (not . isSuccess)
-    -- TODO(arianvp/akshay): Implement if required
-    xit "rejects unknown paths" $
-      Aeson.parse (pathFromJSON [User20]) (Aeson.String "unknown.field") `shouldSatisfy` (not . isSuccess)
-    it "rejects invalid paths" $
-      Aeson.parse (pathFromJSON [User20]) "unknown]field" `shouldSatisfy` (not . isSuccess)
-    describe "Examples from https://tools.ietf.org/html/rfc7644#section-3.5.2 Figure 8" $ do
-      let examples =
-            [ "members",
-              "name.familyname",
-              "addresses[type eq \"work\"]",
-              "members[value eq \"2819c223-7f76-453a-919d-413861904646\"]",
-              "members[value eq \"2819c223-7f76-453a-919d-413861904646\"].displayname"
-            ]
-      for_ examples $ \p -> it ("parses " ++ show p) $ rPath <$> parseOnly (pPath (supportedSchemas @PatchTestTag)) p `shouldBe` Right (decodeUtf8 p)
+    it "throws expected error when patched object doesn't parse" $ do
+      () <- todo
+      True `shouldBe` False
+
+    it "discards all paths that don't match the user/group schema" $ do
+      _ <- todo
+      True `shouldBe` False
+
+    it "Throws error when trying to update immutable / readOnly values" $ do
+      -- https://datatracker.ietf.org/doc/html/rfc7644#section-3.5.2
+      _ <- todo
+      True `shouldBe` False
+
+instance Arbitrary (User (TestTag Text () () NoUserExtra)) where
+  -- TODO: move this to test module in library.
+  arbitrary =
+    {-  do
+      userName <- undefined -- Gen.text (Range.constant 1 20) Gen.unicode
+      externalId <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
+      displayName <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
+      active <- undefined -- Gen.maybe $ ScimBool <$> Gen.bool
+      pure (empty [User20] userName NoUserExtra) {externalId = externalId}
+     -}
+    undefined
diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs
index 1885060fac..9fb748c872 100644
--- a/libs/hscim/test/Test/Schema/UserSpec.hs
+++ b/libs/hscim/test/Test/Schema/UserSpec.hs
@@ -34,6 +34,7 @@ import HaskellWorks.Hspec.Hedgehog (require)
 import Hedgehog
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
+import Imports
 import Lens.Micro
 import Network.URI.Static (uri)
 import Test.Hspec
@@ -44,8 +45,9 @@ import Web.Scim.Filter (AttrPath (..))
 import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..), WithId (..), lowerKey)
 import qualified Web.Scim.Schema.ListResponse as ListResponse
 import Web.Scim.Schema.Meta (ETag (Strong, Weak), Meta (..), WithMeta (..))
-import Web.Scim.Schema.PatchOp (Op (..), Operation (..), PatchOp (..), Patchable (..), Path (..))
+import Web.Scim.Schema.PatchOp
 import qualified Web.Scim.Schema.PatchOp as PatchOp
+import Web.Scim.Schema.Schema
 import Web.Scim.Schema.Schema (Schema (..))
 import Web.Scim.Schema.User (NoUserExtra (..), User (..))
 import qualified Web.Scim.Schema.User as User
@@ -484,8 +486,8 @@ instance ToJSON UserExtraTest where
   toJSON (UserExtraObject t) =
     object ["urn:hscim:test" .= object ["test" .= t]]
 
-instance Patchable UserExtraTest where
-  applyOperation _ _ = undefined
+instance SupportsSchemas UserExtraTest where
+  supportedSchemas _ = undefined
 
 -- | A 'User' with extra fields present.
 extendedUser :: UserExtraTest -> User (TestTag Text () () UserExtraTest)

From af27522f7ac95976178c1bba915d5b68d907b9c5 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Mon, 5 Jan 2026 14:57:11 +0100
Subject: [PATCH 08/13] ...

- smoothen use of `jsonLower`;
---
 libs/hscim/src/Web/Scim/Schema/Common.hs | 29 ++++++-----
 libs/hscim/src/Web/Scim/Schema/User.hs   | 65 ++++++++++++------------
 libs/hscim/test/Test/Schema/UserSpec.hs  |  2 +-
 3 files changed, 51 insertions(+), 45 deletions(-)

diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs
index d1d080a15f..c174f88e47 100644
--- a/libs/hscim/src/Web/Scim/Schema/Common.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Common.hs
@@ -22,9 +22,11 @@
 
 module Web.Scim.Schema.Common where
 
+import Control.Monad.Error.Class
 import Data.Aeson
 import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.KeyMap as KeyMap
+import Data.Aeson.Types (Parser)
 import qualified Data.CaseInsensitive as CI
 import Data.List (nub, (\\))
 import Data.String.Conversions (cs)
@@ -104,9 +106,11 @@ parseOptions =
 -- 'Data.CaseInsensitive.foldCase'.  They're not all the same thing!
 -- https://github.com/basvandijk/case-insensitive/issues/31
 --
--- (FUTUREWORK: The "recursively" part is a bit of a waste and could be dropped, but we would
--- have to spend more effort in making sure it is always called manually in nested parsers.)
-jsonLower :: forall m. (m ~ Either [Text]) => Value -> m Value
+-- NB: The "recursively" part is mostly redundant: to make the code
+-- more robust, we also call `jsonLower` in all relevant `FromJSON`
+-- instances.  But recursing anyway is more robust, and recursion
+-- depth is <= 2.
+jsonLower :: forall m. (MonadError String m) => Value -> m Value
 jsonLower (Object (KeyMap.toList -> olist)) =
   Object . KeyMap.fromList <$> (nubCI >> mapM lowerPair olist)
   where
@@ -115,14 +119,15 @@ jsonLower (Object (KeyMap.toList -> olist)) =
       let unnubbed = Key.toText . fst <$> olist
        in case unnubbed \\ nub unnubbed of
             [] -> pure ()
-            bad@(_ : _) -> Left bad
+            bad@(_ : _) -> throwError $ "case insensitivity check: redundant attributes " <> show bad
     lowerPair :: (Key.Key, Value) -> m (Key.Key, Value)
-    lowerPair (key, val) = (lowerKey key,) <$> jsonLower val
+    lowerPair (key, val) = (Key.fromText . CI.foldCase . Key.toText $ key,) <$> jsonLower val
 jsonLower (Array x) = Array <$> mapM jsonLower x
-jsonLower same@(String _) = Right same -- (only object attributes, not all texts in the value side of objects!)
-jsonLower same@(Number _) = Right same
-jsonLower same@(Bool _) = Right same
-jsonLower same@Null = Right same
-
-lowerKey :: Key.Key -> Key.Key
-lowerKey = Key.fromText . CI.foldCase . Key.toText
+jsonLower same@(String _) = pure same
+jsonLower same@(Number _) = pure same
+jsonLower same@(Bool _) = pure same
+jsonLower same@Null = pure same
+
+-- `jsonLower` for aeson `Parser`s.
+prsJsonLower :: Value -> Parser Value
+prsJsonLower = either fail pure . jsonLower
diff --git a/libs/hscim/src/Web/Scim/Schema/User.hs b/libs/hscim/src/Web/Scim/Schema/User.hs
index 9a97468e25..e35f6037a6 100644
--- a/libs/hscim/src/Web/Scim/Schema/User.hs
+++ b/libs/hscim/src/Web/Scim/Schema/User.hs
@@ -178,38 +178,39 @@ empty schemas userName extra =
     }
 
 instance (FromJSON (UserExtra tag)) => FromJSON (User tag) where
-  parseJSON = withObject "User" $ \obj -> do
-    -- Lowercase all fields
-    let o = KeyMap.fromList . map (over _1 lowerKey) . KeyMap.toList $ obj
-    schemas <-
-      -- TODO(fisx): NO! User20 is NOT implicit?
-      -- https://datatracker.ietf.org/doc/html/rfc7643#section-3
-      -- (Also make sure this works as expected in Group!)
-      o .:? "schemas" <&> \case
-        Nothing -> [User20]
-        Just xs -> if User20 `elem` xs then xs else User20 : xs
-    userName <- o .: "username"
-    externalId <- o .:? "externalid"
-    name <- o .:? "name"
-    displayName <- o .:? "displayname"
-    nickName <- o .:? "nickname"
-    profileUrl <- o .:? "profileurl"
-    title <- o .:? "title"
-    userType <- o .:? "usertype"
-    preferredLanguage <- o .:? "preferredlanguage"
-    locale <- o .:? "locale"
-    active <- o .:? "active"
-    password <- o .:? "password"
-    emails <- o .:? "emails" .!= []
-    phoneNumbers <- o .:? "phonenumbers" .!= []
-    ims <- o .:? "ims" .!= []
-    photos <- o .:? "photos" .!= []
-    addresses <- o .:? "addresses" .!= []
-    entitlements <- o .:? "entitlements" .!= []
-    roles <- o .:? "roles" .!= []
-    x509Certificates <- o .:? "x509certificates" .!= []
-    extra <- parseJSON (Object obj)
-    pure User {..}
+  parseJSON = prsJsonLower >=> prs
+    where
+      prs = withObject "User" $ \o -> do
+        -- Lowercase all fields
+        schemas <-
+          -- TODO(fisx): NO! User20 is NOT implicit?
+          -- https://datatracker.ietf.org/doc/html/rfc7643#section-3
+          -- (Also make sure this works as expected in Group!)
+          o .:? "schemas" <&> \case
+            Nothing -> [User20]
+            Just xs -> if User20 `elem` xs then xs else User20 : xs
+        userName <- o .: "username"
+        externalId <- o .:? "externalid"
+        name <- o .:? "name"
+        displayName <- o .:? "displayname"
+        nickName <- o .:? "nickname"
+        profileUrl <- o .:? "profileurl"
+        title <- o .:? "title"
+        userType <- o .:? "usertype"
+        preferredLanguage <- o .:? "preferredlanguage"
+        locale <- o .:? "locale"
+        active <- o .:? "active"
+        password <- o .:? "password"
+        emails <- o .:? "emails" .!= []
+        phoneNumbers <- o .:? "phonenumbers" .!= []
+        ims <- o .:? "ims" .!= []
+        photos <- o .:? "photos" .!= []
+        addresses <- o .:? "addresses" .!= []
+        entitlements <- o .:? "entitlements" .!= []
+        roles <- o .:? "roles" .!= []
+        x509Certificates <- o .:? "x509certificates" .!= []
+        extra <- parseJSON (Object o)
+        pure User {..}
 
 instance (ToJSON (UserExtra tag)) => ToJSON (User tag) where
   toJSON User {..} =
diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs
index 9fb748c872..ce7635be4f 100644
--- a/libs/hscim/test/Test/Schema/UserSpec.hs
+++ b/libs/hscim/test/Test/Schema/UserSpec.hs
@@ -42,7 +42,7 @@ import Test.Schema.Util (genUri, mk_prop_caseInsensitive)
 import Text.Email.Validate (emailAddress, validate)
 import qualified Web.Scim.Class.User as UserClass
 import Web.Scim.Filter (AttrPath (..))
-import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..), WithId (..), lowerKey)
+import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..), WithId (..), prsJsonLower)
 import qualified Web.Scim.Schema.ListResponse as ListResponse
 import Web.Scim.Schema.Meta (ETag (Strong, Weak), Meta (..), WithMeta (..))
 import Web.Scim.Schema.PatchOp

From 00e330ccbfc9520825c7935df100de28662ff51b Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Mon, 5 Jan 2026 17:35:21 +0100
Subject: [PATCH 09/13] ...

- new scim patch type, with an applyPatch implementation in terms of
  aeson-diff and aeson-schema;
---
 libs/hscim/hscim.cabal                     |   1 +
 libs/hscim/src/Web/Scim/Schema/PatchOp.hs  | 326 +++++++++++++--------
 libs/hscim/src/Web/Scim/Schema/Schema.hs   |   7 +
 libs/hscim/test/Test/Schema/PatchOpSpec.hs |  93 +++---
 4 files changed, 251 insertions(+), 176 deletions(-)

diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index b9dff35ef6..0196cb3576 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -82,6 +82,7 @@ library
     TypeFamilies
     TypeOperators
     TypeSynonymInstances
+    ViewPatterns
 
   ghc-options:        -Wall -Wredundant-constraints -Wunused-packages
   build-depends:
diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
index 1ac01c3b16..fe9faca54a 100644
--- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
+++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
@@ -17,134 +17,222 @@
 
 module Web.Scim.Schema.PatchOp where
 
-import Control.Applicative
-import Control.Monad (guard)
-import Control.Monad.Except
-import qualified Data.Aeson.Key as Key
-import qualified Data.Aeson.KeyMap as KeyMap
-import Data.Aeson.Types (FromJSON (parseJSON), ToJSON (toJSON), Value (String), object, withObject, withText, (.:), (.:?), (.=))
-import qualified Data.Aeson.Types as Aeson
-import Data.Attoparsec.ByteString (Parser, endOfInput, parseOnly)
+import Control.Monad.Error.Class (MonadError, throwError)
+import Data.Aeson
+import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.:), (.:?), (.=))
+import qualified Data.Aeson.Diff as AD
+import qualified Data.Aeson.KeyMap as AK
+import qualified Data.Aeson.Patch as AD
+import qualified Data.Aeson.Pointer as AD
+import Data.Aeson.Types
 import Data.Bifunctor (first)
 import qualified Data.CaseInsensitive as CI
+import Data.List.NonEmpty
+import Data.Proxy (Proxy (Proxy))
+import qualified Data.Set as Set
 import Data.Text (Text)
-import Data.Text.Encoding (encodeUtf8)
-import Web.Scim.AttrName (AttrName (..))
-import Web.Scim.Filter (AttrPath (..), SubAttr (..), ValuePath (..), pAttrPath, pSubAttr, pValuePath, rAttrPath, rSubAttr, rValuePath)
-import Web.Scim.Schema.Common (lowerKey)
+import qualified Data.Text as T
+import qualified Data.Text as Text
+import Debug.Trace
+import Imports
+import Web.Scim.Filter
+import Web.Scim.Schema.Common
 import Web.Scim.Schema.Error
-import Web.Scim.Schema.Schema (Schema (PatchOp20))
-import Web.Scim.Schema.UserTypes (UserTypes (supportedSchemas))
+import Web.Scim.Schema.Schema
 
-newtype PatchOp tag = PatchOp
-  {getOperations :: [Operation]}
-  deriving (Eq, Show)
-
--- | The 'Path' attribute value is a 'String' containing an attribute path
--- describing the target of the operation.  It is OPTIONAL
--- for 'Op's "add" and "replace", and is REQUIRED for "remove".  See
--- relevant operation sections below for details.
+-- This type provides the parser for the scim patch syntax, and can be
+-- turned into an `AD.Patch` with `validatePatchOp`.
+--
+-- Differences to AD.Patch:
+-- - Only add, remove, replace.
+-- - Point into array with filters, not indices.
+-- - Case insensitive.
+-- - The semantics is a bit convoluted and may diverge from that of
+--   `AD.Patch` (see RFCs).
+--
+-- The Schemas associated with `tag` are only validated in
+-- `applyPatch`.  We could do validation in `jsonPatchToScimPatch`,
+-- but that seemed unnecessarily complicated.
 --
--- TODO(arianvp):  When value is an array, it needs special handling.
--- e.g. primary fields need to be negated and whatnot.
--- We currently do not do that :)
+-- Example:
 --
--- NOTE: When the path contains a schema, this schema must be implicitly added
--- to the list of schemas on the result type
-data Operation = Operation
-  { op :: Op,
-    path :: Maybe Path,
-    value :: Maybe Value
-  }
+--    { "schemas":
+--        ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+--      "Operations":[
+--        {
+--         "op":"add",
+--         "path":"members",
+--         "value":[
+--          {
+--            "display": "Babs Jensen",
+--            "$ref": "https://example.com/v2/Users/2819c223...413861904646",
+--            "value": "2819c223-7f76-453a-919d-413861904646"
+--          }
+--         ]
+--        },
+--        ... + additional operations if needed ...
+--      ]
+--    }
+--
+-- patch for scim: https://datatracker.ietf.org/doc/html/rfc7644#section-3.5.2
+-- patch for json: https://datatracker.ietf.org/doc/html/rfc6901
+newtype Patch tag = Patch {fromPatch :: [PatchOp tag]}
   deriving (Eq, Show)
 
-data Op
-  = Add
-  | Replace
-  | Remove
-  deriving (Eq, Show, Enum, Bounded)
-
--- | PATH = attrPath / valuePath [subAttr]
-data Path
-  = NormalPath AttrPath
-  | IntoValuePath ValuePath (Maybe SubAttr)
+data PatchOp tag
+  = PatchOpAdd (Maybe AttrPath) Value
+  | PatchOpRemove AttrPath
+  | PatchOpReplace (Maybe AttrPath) Value
   deriving (Eq, Show)
 
-parsePath :: [Schema] -> Text -> Either String Path
-parsePath schemas' = parseOnly (pPath schemas' <* endOfInput) . encodeUtf8
-
--- | PATH = attrPath / valuePath [subAttr]
-pPath :: [Schema] -> Parser Path
-pPath schemas' =
-  IntoValuePath <$> pValuePath schemas' <*> optional pSubAttr
-    <|> NormalPath <$> pAttrPath schemas'
-
-rPath :: Path -> Text
-rPath (NormalPath attrPath) = rAttrPath attrPath
-rPath (IntoValuePath valuePath subAttr) = rValuePath valuePath <> maybe "" rSubAttr subAttr
-
--- TODO(arianvp): According to the SCIM spec we should throw an InvalidPath
--- error when the path is invalid syntax. this is a bit hard to do though as we
--- can't control what errors FromJSON throws :/
-instance (UserTypes tag) => FromJSON (PatchOp tag) where
-  parseJSON = withObject "PatchOp" $ \v -> do
-    let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v
-    schemas' :: [Schema] <- o .: "schemas"
-    guard $ PatchOp20 `elem` schemas'
-    operations <- Aeson.explicitParseField (Aeson.listParser $ operationFromJSON (supportedSchemas @tag)) o "operations"
-    pure $ PatchOp operations
-
-instance ToJSON (PatchOp tag) where
-  toJSON (PatchOp operations) =
-    object ["operations" .= operations, "schemas" .= [PatchOp20]]
-
--- TODO: Azure wants us to be case-insensitive on _values_ as well here.  We currently do not
--- comply with that.
-operationFromJSON :: [Schema] -> Value -> Aeson.Parser Operation
-operationFromJSON schemas' =
-  withObject "Operation" $ \v -> do
-    let o = KeyMap.fromList . map (first lowerKey) . KeyMap.toList $ v
-    Operation
-      <$> (o .: "op")
-      <*> Aeson.explicitParseFieldMaybe (pathFromJSON schemas') o "path"
-      <*> (o .:? "value")
-
-pathFromJSON :: [Schema] -> Value -> Aeson.Parser Path
-pathFromJSON schemas' =
-  withText "Path" $ either fail pure . parsePath schemas'
-
-instance ToJSON Operation where
-  toJSON (Operation op' path' value') =
-    object $ ("op" .= op') : optionalField "path" path' ++ optionalField "value" value'
+----------------------------------------------------------------------
+
+-- | Compute a patch operation for the aeson-diff package.  The
+-- `Value` argument is needed to compute absolute indices into arrays
+-- from the filter expressions in the scim patch.
+scimPatchToJsonPatch :: forall tag m. (MonadError String m) => Patch tag -> Value -> m AD.Patch
+scimPatchToJsonPatch (Patch scimOps) jsonOrig = do
+  (mapOp `mapM` scimOps) <&> AD.Patch
+  where
+    mapOp :: PatchOp tag -> m AD.Operation
+    mapOp = \case
+      PatchOpAdd mbAttrPath val -> mapPath mbAttrPath <&> (`AD.Add` val)
+      PatchOpRemove attrPath -> mapPath (Just attrPath) <&> AD.Rem
+      PatchOpReplace mbAttrPath val -> mapPath mbAttrPath <&> (`AD.Rep` val)
+
+    mapPath :: Maybe AttrPath -> m AD.Pointer
+    mapPath Nothing = pure emptyPath
+    mapPath (Just _) =
+      -- FUTUREWORK: map array filters to array indices.
+      todo
+
+-- | NB: this does not validate schemas. See haddocks of a`Patch` above.
+jsonPatchToScimPatch :: forall tag m. (MonadError String m) => AD.Patch -> Value -> m (Patch tag)
+jsonPatchToScimPatch jsonPatch jsonOrig = do
+  (mapOp `mapM` (AD.patchOperations jsonPatch)) <&> Patch
+  where
+    mapOp :: AD.Operation -> m (PatchOp tag)
+    mapOp = \case
+      AD.Add path val -> todo
+      AD.Rem path -> todo
+      AD.Rep path val -> todo
+      AD.Mov {} -> throwError "unsupported patch operation: mov"
+      AD.Cpy {} -> throwError "unsupported patch operation: cpy"
+      AD.Tst {} -> throwError "unsupported patch operation: tst"
+
+    mapPath :: AD.Pointer -> AttrPath
+    mapPath = todo
+
+emptyPath :: AD.Pointer
+emptyPath =
+  parseEither AD.parsePointer ""
+    & either (error . ("impossible: " <>) . show) Imports.id
+
+----------------------------------------------------------------------
+
+instance (SupportsSchemas tag) => ToJSON (Patch tag) where
+  toJSON (Patch ops) =
+    object $
+      [ "schemas" .= [PatchOp20],
+        "operations" .= ops
+      ]
+
+instance (SupportsSchemas tag) => ToJSON (PatchOp tag) where
+  toJSON op =
+    object $
+      ["op" .= String (patchOpName op)]
+        <> ["path" .= p | p <- maybeToList $ patchOpPath op]
+        <> ["value" .= v | v <- maybeToList $ patchOpVal op]
+    where
+      patchOpName :: PatchOp tag -> Text
+      patchOpName = \case
+        PatchOpAdd _ _ -> "add"
+        PatchOpRemove _ -> "remove"
+        PatchOpReplace _ _ -> "replace"
+
+      patchOpPath :: PatchOp tag -> Maybe AttrPath
+      patchOpPath = \case
+        PatchOpAdd mbp _ -> mbp
+        PatchOpRemove p -> Just $ p
+        PatchOpReplace mbp _ -> mbp
+
+      patchOpVal :: PatchOp tag -> Maybe Value
+      patchOpVal = \case
+        PatchOpAdd _ v -> Just v
+        PatchOpRemove _ -> Nothing
+        PatchOpReplace _ v -> Just v
+
+----------------------------------------------------------------------
+
+instance (SupportsSchemas tag) => FromJSON (Patch tag) where
+  parseJSON = prsJsonLower >=> prs
+    where
+      prs = withObject "ScimPatch" $ \ciObj -> do
+        given <- ciObj .: "schemas"
+        unless (given == Set.singleton PatchOp20) $ do
+          fail $ "Unsupported schemas!  must be " <> show [getSchemaUri PatchOp20]
+        Patch <$> ciObj .: "operations"
+
+-- | Lower-case all case-insensitive parts of a scim value.  These are:
+-- - Attributes schemas, operations, op of the patch itself (https://datatracker.ietf.org/doc/html/rfc7643#section-2.1)
+-- - Attribute names in the values to be added / replaced (https://datatracker.ietf.org/doc/html/rfc7643#section-2.1)
+-- - Attribute paths with filters (https://datatracker.ietf.org/doc/html/rfc7644#section-3.4.2.2)
+--   (example: `filter=emails[type eq "work"] eq "john"` vs. `filter=EMAILS[TYPE EQ "WORK"] EQ "john"`)
+lowerAllCaseInsensitiveThingsInPatch :: Value -> Either String Value
+lowerAllCaseInsensitiveThingsInPatch = attrNamesInPaths <=< jsonLower
+  where
+    attrNamesInPaths = pure -- FUTUREWORK: we don't support this yet, so no need to lower-case it either.
+
+instance (SupportsSchemas tag) => FromJSON (PatchOp tag) where
+  parseJSON = (either fail pure . lowerAllCaseInsensitiveThingsInPatch) >=> prs
     where
-      optionalField fname = \case
-        Nothing -> []
-        Just x -> [fname .= x]
-
-instance FromJSON Op where
-  parseJSON = withText "Op" $ \op' ->
-    case CI.foldCase op' of
-      "add" -> pure Add
-      "replace" -> pure Replace
-      "remove" -> pure Remove
-      _ -> fail "unknown operation"
-
-instance ToJSON Op where
-  toJSON Add = String "add"
-  toJSON Replace = String "replace"
-  toJSON Remove = String "remove"
-
-instance ToJSON Path where
-  toJSON = String . rPath
-
--- | A very coarse description of what it means to be 'Patchable'
--- I do not like it. We should handhold people using this library more
-class Patchable a where
-  applyOperation :: (MonadError ScimError m) => a -> Operation -> m a
-
-instance Patchable (KeyMap.KeyMap Text) where
-  applyOperation theMap (Operation Remove (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) _) =
-    pure $ KeyMap.delete (Key.fromText attrName) theMap
-  applyOperation theMap (Operation _AddOrReplace (Just (NormalPath (AttrPath _schema (AttrName attrName) _subAttr))) (Just (String val))) =
-    pure $ KeyMap.insert (Key.fromText attrName) val theMap
-  applyOperation _ _ = throwError $ badRequest InvalidValue $ Just "Unsupported operation"
+      prs = withObject "ScimPatchOp" $ \o -> do
+        o .: "op" >>= \case
+          "add" -> do
+            path <- o .:? "path"
+            val <- o .: "value"
+            pure $ PatchOpAdd path val
+          "remove" -> do
+            path <- o .: "path"
+            pure $ PatchOpRemove path
+          "replace" -> do
+            path <- o .:? "path"
+            val <- o .: "value"
+            pure $ PatchOpReplace path val
+          unknownOp -> fail $ "Unknown operation: " ++ T.unpack unknownOp
+
+----------------------------------------------------------------------
+
+-- Translate Patch into AD.Patch from the aeson-diff package and apply
+-- the diff.  Validate input value and output value against supported
+-- schemas, but validating the patch itself is redundant.
+applyPatch ::
+  forall m tag a.
+  ( SupportsSchemas tag,
+    FromJSON a,
+    ToJSON a,
+    MonadError ScimError m
+  ) =>
+  Patch tag ->
+  a ->
+  m a
+applyPatch scimPatch (toJSON -> jsonOrig) = do
+  jsonPatch <-
+    scimPatchToJsonPatch scimPatch jsonOrig
+      & either (throwError . badRequest InvalidSyntax . Just . ("Could not parse patch operation(s): " <>) . Text.pack) pure
+
+  let result err = \case
+        Success val -> pure val
+        Error txt -> throwError . badRequest InvalidValue . Just . err $ Text.pack txt
+
+  jsonPatched <-
+    AD.patch jsonPatch jsonOrig
+      & result ("could not apply patch: " <>)
+
+  validateSchemas @tag Proxy jsonOrig
+    & either (throwError . badRequest InvalidSyntax . Just . ("Validation of input value failed: " <>) . Text.pack) pure
+  validateSchemas @tag Proxy jsonPatched
+    & either (throwError . badRequest InvalidSyntax . Just . ("Validation of output value failed: " <>) . Text.pack) pure
+
+  fromJSON jsonPatched
+    & result ("invalid patch result: " <>)
diff --git a/libs/hscim/src/Web/Scim/Schema/Schema.hs b/libs/hscim/src/Web/Scim/Schema/Schema.hs
index 2339429d13..1ad87d44a7 100644
--- a/libs/hscim/src/Web/Scim/Schema/Schema.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Schema.hs
@@ -17,6 +17,7 @@
 
 module Web.Scim.Schema.Schema where
 
+import Control.Monad.Error.Class
 import Data.Aeson (FromJSON, ToJSON, Value, parseJSON, toJSON, withText)
 import Data.Attoparsec.ByteString (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as Parser
@@ -24,6 +25,7 @@ import Data.Data (Proxy)
 import Data.Set (Set)
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Imports
 import Web.Scim.Capabilities.MetaSchema.Group
 import Web.Scim.Capabilities.MetaSchema.ResourceType
 import Web.Scim.Capabilities.MetaSchema.SPConfig
@@ -159,3 +161,8 @@ class SupportsSchemas a where
   -- | Schemas supported by the the tagged type. API clients touching
   -- fields not contained in the listed schemas triggers error 4xx.
   supportedSchemas :: Proxy a -> Set Schema
+
+-- use https://github.com/ocramz/aeson-schema to validate the listed
+-- schemas.
+validateSchemas :: forall tag m. (SupportsSchemas tag, MonadError String m) => Proxy tag -> Value -> m ()
+validateSchemas = todo
diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
index bfc0735a5d..31dfc432c9 100644
--- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs
+++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
@@ -34,8 +34,10 @@ import Imports
 import Test.Hspec
 import Test.Hspec.QuickCheck
 import Test.QuickCheck
+import Web.Scim.AttrName
 import Web.Scim.Filter
 import Web.Scim.Schema.PatchOp
+import Web.Scim.Schema.Schema
 import Web.Scim.Schema.User
 import Web.Scim.Test.Util
 
@@ -45,71 +47,48 @@ type UserExtraPatch = KeyMap.KeyMap Text
 
 spec :: Spec
 spec = do
-  describe "PatchOp" $ do
-    ----------------------------------------------------------------------
-
-    it "golden + simple roundtrip" $ do
-      let check :: (PatchOp PatchTag, Value) -> Expectation
-          check (hs, js) = do
-            toJSON hs `shouldBe` js
-            case parseEither parseJSON js of
-              Left err -> expectationFailure $ "Failed to parse: " ++ err
-              Right (have :: PatchOp PatchTag) -> have `shouldBe` hs
+  describe "Patch" $ do
+    it "golden" $ do
+      let check :: (HasCallStack) => (Patch PatchTag, Value) -> Expectation
+          check (hs, js) = Right (toJSON hs) `shouldBe` lowerAllCaseInsensitiveThingsInPatch js
 
       check
-        `mapM_` [ ( todo, -- PatchOp (AD.Patch []),
+        `mapM_` [ ( Patch [PatchOpAdd (Just $ AttrPath Nothing (AttrName "userName") Nothing) (String "testuser")],
                     [aesonQQ|
-                    {
-                    "schemaS": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                      "OperaTions": [{
-                        "oP": "aDD",
-                        "pATh": "userName",
-                        "vaLUE": "testuser"
-                      }]
+                    { "schemaS": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                      "operATIONS": [
+                        { "oP": "add",
+                          "pATh": "userName",
+                          "vaLUE": "testuser"
+                        }
+                      ]
+                    }
+                    |]
+                  ),
+                  ( Patch [PatchOpReplace Nothing (String "this won't work in applyPatch")],
+                    [aesonQQ|
+                    { "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                      "operations": [
+                        { "oP": "replace",
+                          "vaLUE": "this won't work in applyPatch"
+                        }
+                      ]
+                    }
+                    |]
+                  ),
+                  ( Patch [PatchOpRemove (AttrPath (Just User20) (AttrName "userName") Nothing)],
+                    [aesonQQ|
+                    { "Schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
+                      "Operations": [
+                        { "op": "remove",
+                          "path": "urn:ietf:params:scim:schemas:core:2.0:User:userName"
+                        }
+                      ]
                     }
                     |]
                   )
                 ]
 
-    -- todo "test missing path field for add, rep"
-
-    it "Operation attributes and value attributes are case-insensitive" $ do
-      let patches :: [Value] =
-            [ [aesonQQ|
-              {
-                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                "Operations": [{
-                  "op": "replace",
-                  "path": "displayName",
-                  "value": "Name"
-                }]
-              }
-              |],
-              [aesonQQ|
-              {
-                "schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                "Operations": [{
-                  "op": "REPLACE",
-                  "path": "displayName",
-                  "value": "Name"
-                }]
-              }
-              |],
-              [aesonQQ|
-              {
-                "Schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
-                "Operations": [{
-                  "OP": "Replace",
-                  "PATH": "dISPlayName",
-                  "VALUE": "Name"
-                }]
-              }
-              |]
-            ]
-      case nub $ (eitherDecode @(PatchOp PatchTag) . encode) <$> patches of
-        [Right _] -> pure ()
-        bad -> expectationFailure $ "Case insensitivity check failed, the following variantions should not be distinguished: " ++ show bad
-
   describe "applyPatch" $ do
     prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
       \(barbie :: User (TestTag Text () () NoUserExtra)) changedWant ->

From df012ca2bb250ed0c6108ed9f936910ddd4bf5de Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 6 Jan 2026 11:00:21 +0100
Subject: [PATCH 10/13] [STASH]

---
 libs/hscim/hscim.cabal                     |   1 +
 libs/hscim/src/Web/Scim/Class/User.hs      |  14 +--
 libs/hscim/src/Web/Scim/Filter.hs          |  22 ++++-
 libs/hscim/src/Web/Scim/Schema/PatchOp.hs  | 100 ++++++++++++++-------
 libs/hscim/test/Test/FilterSpec.hs         |   7 +-
 libs/hscim/test/Test/Schema/PatchOpSpec.hs |  72 ++++++++++-----
 libs/hscim/test/Test/Schema/UserSpec.hs    |  49 +++++-----
 7 files changed, 180 insertions(+), 85 deletions(-)

diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index 0196cb3576..956f552058 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -123,6 +123,7 @@ library
     , time
     , utf8-string
     , uuid
+    , vector
     , wai
     , wai-extra
     , wai-utilities
diff --git a/libs/hscim/src/Web/Scim/Class/User.hs b/libs/hscim/src/Web/Scim/Class/User.hs
index dd0feed872..e83c689db4 100644
--- a/libs/hscim/src/Web/Scim/Class/User.hs
+++ b/libs/hscim/src/Web/Scim/Class/User.hs
@@ -138,16 +138,20 @@ class (Monad m, AuthTypes tag, UserTypes tag) => UserDB tag m where
     PatchOp tag ->
     ScimHandler m (StoredUser tag)
   default patchUser ::
-    (Patchable (UserExtra tag), FromJSON (UserExtra tag)) =>
+    -- (Patchable (UserExtra tag), FromJSON (UserExtra tag)) =>
     AuthInfo tag ->
     UserId tag ->
     -- | PATCH payload
     PatchOp tag ->
     ScimHandler m (StoredUser tag)
-  patchUser info uid op' = do
-    (WithMeta _ (WithId _ (user :: User tag))) <- getUser info uid
-    (newUser :: User tag) <- applyPatch user op'
-    putUser info uid newUser
+  patchUser = undefined
+
+  {-
+    patchUser info uid op' = do
+      (WithMeta _ (WithId _ (user :: User tag))) <- getUser info uid
+      (newUser :: User tag) <- applyPatch user op'
+      putUser info uid newUser
+  -}
 
   -- | Delete a user.
   --
diff --git a/libs/hscim/src/Web/Scim/Filter.hs b/libs/hscim/src/Web/Scim/Filter.hs
index 52b57ace82..68ed76e5ff 100644
--- a/libs/hscim/src/Web/Scim/Filter.hs
+++ b/libs/hscim/src/Web/Scim/Filter.hs
@@ -145,10 +145,19 @@ data Filter
   deriving (Eq, Show)
 
 -- | valuePath = attrPath "[" valFilter "]"
+--
+-- A `ValuePath` without a `Filter` is morally an `AttrPath`.
+--
+-- Cases covered:
+-- - '.roles'
+-- - '.bla.foo'
+-- - '.email["type" eq "work"]'
+--
 -- 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
+-- https://datatracker.ietf.org/doc/html/rfc7644#section-3.4.2.2
+data ValuePath = ValuePath AttrPath (Maybe Filter)
   deriving (Eq, Show)
 
 -- | subAttr   = "." ATTRNAME
@@ -195,7 +204,7 @@ pSubAttr = char '.' *> (SubAttr <$> pAttrName)
 -- | valuePath = attrPath "[" valFilter "]"
 pValuePath :: [Schema] -> Parser ValuePath
 pValuePath supportedSchemas =
-  ValuePath <$> pAttrPath supportedSchemas <*> (char '[' *> pFilter supportedSchemas <* char ']')
+  ValuePath <$> pAttrPath supportedSchemas <*> (Just <$> (char '[' *> pFilter supportedSchemas <* char ']'))
 
 -- | Value literal parser.
 pCompValue :: Parser CompValue
@@ -254,7 +263,8 @@ rSubAttr :: SubAttr -> Text
 rSubAttr (SubAttr x) = "." <> rAttrName x
 
 rValuePath :: ValuePath -> Text
-rValuePath (ValuePath attrPath filter') = rAttrPath attrPath <> "[" <> renderFilter filter' <> "]"
+rValuePath (ValuePath attrPath Nothing) = rAttrPath attrPath
+rValuePath (ValuePath attrPath (Just filter')) = rAttrPath attrPath <> "[" <> renderFilter filter' <> "]"
 
 -- | Value literal renderer.
 rCompValue :: CompValue -> Text
@@ -306,3 +316,9 @@ instance ToJSON AttrPath where
 
 instance FromJSON AttrPath where
   parseJSON val = parseJSON @Text val >>= either fail pure . parseOnly (pAttrPath []) . encodeUtf8
+
+instance ToJSON ValuePath where
+  toJSON = todo
+
+instance FromJSON ValuePath where
+  parseJSON = todo
diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
index fe9faca54a..18529f3240 100644
--- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
+++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
@@ -19,22 +19,19 @@ module Web.Scim.Schema.PatchOp where
 
 import Control.Monad.Error.Class (MonadError, throwError)
 import Data.Aeson
-import Data.Aeson (FromJSON (..), ToJSON (..), Value, object, withObject, (.:), (.:?), (.=))
 import qualified Data.Aeson.Diff as AD
+import qualified Data.Aeson.Key as AK
 import qualified Data.Aeson.KeyMap as AK
 import qualified Data.Aeson.Patch as AD
 import qualified Data.Aeson.Pointer as AD
 import Data.Aeson.Types
-import Data.Bifunctor (first)
-import qualified Data.CaseInsensitive as CI
-import Data.List.NonEmpty
 import Data.Proxy (Proxy (Proxy))
 import qualified Data.Set as Set
-import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text as Text
-import Debug.Trace
+import qualified Data.Vector as V
 import Imports
+import Web.Scim.AttrName
 import Web.Scim.Filter
 import Web.Scim.Schema.Common
 import Web.Scim.Schema.Error
@@ -76,13 +73,13 @@ import Web.Scim.Schema.Schema
 --
 -- patch for scim: https://datatracker.ietf.org/doc/html/rfc7644#section-3.5.2
 -- patch for json: https://datatracker.ietf.org/doc/html/rfc6901
-newtype Patch tag = Patch {fromPatch :: [PatchOp tag]}
+newtype Patch tag = Patch {fromPatch :: [PatchOp tag]} -- TODO: rename to `ScimPatch`, and PatchOp to `ScimPatchOp`?
   deriving (Eq, Show)
 
 data PatchOp tag
-  = PatchOpAdd (Maybe AttrPath) Value
-  | PatchOpRemove AttrPath
-  | PatchOpReplace (Maybe AttrPath) Value
+  = PatchOpAdd (Maybe ValuePath) Value
+  | PatchOpRemove ValuePath
+  | PatchOpReplace (Maybe ValuePath) Value
   deriving (Eq, Show)
 
 ----------------------------------------------------------------------
@@ -90,38 +87,79 @@ data PatchOp tag
 -- | Compute a patch operation for the aeson-diff package.  The
 -- `Value` argument is needed to compute absolute indices into arrays
 -- from the filter expressions in the scim patch.
-scimPatchToJsonPatch :: forall tag m. (MonadError String m) => Patch tag -> Value -> m AD.Patch
+--
+-- Scim schema information in `AttrName`s is ignored (`AD.Patch` does
+-- not do schema validation).
+scimPatchToJsonPatch :: forall tag. Patch tag -> Value -> AD.Patch
 scimPatchToJsonPatch (Patch scimOps) jsonOrig = do
-  (mapOp `mapM` scimOps) <&> AD.Patch
+  AD.Patch (concat (mapOp <$> scimOps))
   where
-    mapOp :: PatchOp tag -> m AD.Operation
+    mapOp :: PatchOp tag -> [AD.Operation]
     mapOp = \case
-      PatchOpAdd mbAttrPath val -> mapPath mbAttrPath <&> (`AD.Add` val)
-      PatchOpRemove attrPath -> mapPath (Just attrPath) <&> AD.Rem
-      PatchOpReplace mbAttrPath val -> mapPath mbAttrPath <&> (`AD.Rep` val)
+      PatchOpAdd mbAttrPath val -> (`AD.Add` val) <$> mapPath mbAttrPath
+      PatchOpRemove attrPath -> AD.Rem <$> mapPath (Just attrPath)
+      PatchOpReplace mbAttrPath val -> (`AD.Rep` val) <$> mapPath mbAttrPath
+
+    mapPath :: Maybe ValuePath -> [AD.Pointer]
+    mapPath Nothing = [emptyPath]
+    mapPath (Just (ValuePath (AttrPath _mbSchema name mbSub) Nothing)) =
+      [AD.Pointer (nm : sub)]
+      where
+        nm = AD.OKey . AK.fromText . rAttrName $ name
+        sub = [AD.OKey . AK.fromText . rAttrName $ subName | SubAttr subName <- maybeToList mbSub]
+    mapPath (Just (ValuePath (AttrPath _mbSchema name Nothing) mbFilter)) =
+      [AD.Pointer [nm]]
+        <> case mbFilter of
+          Nothing -> []
+          Just fltr -> ixToValPaths <$> arrFilterToIndices fltr arr
+      where
+        nm@(AD.OKey key) = AD.OKey . AK.fromText . rAttrName $ name
+        arr = case jsonOrig of
+          Object obj -> case AK.lookup key obj of
+            Just (Array vec) -> V.toList vec
+            _ -> todo
+          _ -> todo
+        ixToValPaths :: Int -> AD.Pointer
+        ixToValPaths ix = todo
 
-    mapPath :: Maybe AttrPath -> m AD.Pointer
-    mapPath Nothing = pure emptyPath
-    mapPath (Just _) =
-      -- FUTUREWORK: map array filters to array indices.
-      todo
+arrFilterToIndices :: Filter -> [Value] -> [Int]
+arrFilterToIndices _ _ = todo
 
--- | NB: this does not validate schemas. See haddocks of a`Patch` above.
+-- | The inverse of `jsonPatchToScimPatch`.  This does not validate
+-- schemas, and never fills the schema argument of `AttrPath`.  See
+-- haddocks of `Patch` above.  Since `AD.Patch` is more expressive
+-- than `Patch`, this can have errors.
 jsonPatchToScimPatch :: forall tag m. (MonadError String m) => AD.Patch -> Value -> m (Patch tag)
 jsonPatchToScimPatch jsonPatch jsonOrig = do
   (mapOp `mapM` (AD.patchOperations jsonPatch)) <&> Patch
   where
     mapOp :: AD.Operation -> m (PatchOp tag)
     mapOp = \case
-      AD.Add path val -> todo
-      AD.Rem path -> todo
-      AD.Rep path val -> todo
+      AD.Add path val -> (`PatchOpAdd` val) <$> mapPath path
+      AD.Rem path -> mapPath path >>= maybe (throwError "remove op requires path argument.") (pure . PatchOpRemove)
+      AD.Rep path val -> (`PatchOpReplace` val) <$> mapPath path
       AD.Mov {} -> throwError "unsupported patch operation: mov"
       AD.Cpy {} -> throwError "unsupported patch operation: cpy"
       AD.Tst {} -> throwError "unsupported patch operation: tst"
 
-    mapPath :: AD.Pointer -> AttrPath
-    mapPath = todo
+    mapPath :: AD.Pointer -> m (Maybe ValuePath)
+    mapPath (AD.Pointer []) = pure Nothing
+    mapPath (AD.Pointer [AD.OKey key]) = pure $ Just (ValuePath (topLevelAttrPath (AK.toText key)) Nothing)
+    mapPath (AD.Pointer [AD.OKey key, AD.OKey sub]) = todo key sub
+    mapPath (AD.Pointer [AD.OKey key, AD.AKey ix]) = do
+      let fltr = arrIndexToFilter ix arr
+          arr = case jsonOrig of
+            Object obj -> case AK.lookup key obj of
+              Just (Array vec) -> V.toList vec
+              _ -> todo
+            _ -> todo
+          attr = topLevelAttrPath (AK.toText key)
+      pure $ Just (ValuePath attr (Just fltr))
+    mapPath (AD.Pointer [AD.OKey key, AD.AKey ix, AD.OKey sub]) = todo key ix sub
+    mapPath bad = throwError $ "illegal or unsupported attribute path: " <> show bad
+
+arrIndexToFilter :: Int -> [Value] -> Filter
+arrIndexToFilter _ _ = todo
 
 emptyPath :: AD.Pointer
 emptyPath =
@@ -150,7 +188,7 @@ instance (SupportsSchemas tag) => ToJSON (PatchOp tag) where
         PatchOpRemove _ -> "remove"
         PatchOpReplace _ _ -> "replace"
 
-      patchOpPath :: PatchOp tag -> Maybe AttrPath
+      patchOpPath :: PatchOp tag -> Maybe ValuePath
       patchOpPath = \case
         PatchOpAdd mbp _ -> mbp
         PatchOpRemove p -> Just $ p
@@ -217,11 +255,9 @@ applyPatch ::
   a ->
   m a
 applyPatch scimPatch (toJSON -> jsonOrig) = do
-  jsonPatch <-
-    scimPatchToJsonPatch scimPatch jsonOrig
-      & either (throwError . badRequest InvalidSyntax . Just . ("Could not parse patch operation(s): " <>) . Text.pack) pure
+  let jsonPatch = scimPatchToJsonPatch scimPatch jsonOrig
 
-  let result err = \case
+      result err = \case
         Success val -> pure val
         Error txt -> throwError . badRequest InvalidValue . Just . err $ Text.pack txt
 
diff --git a/libs/hscim/test/Test/FilterSpec.hs b/libs/hscim/test/Test/FilterSpec.hs
index 44d7f2cfff..4131b39dda 100644
--- a/libs/hscim/test/Test/FilterSpec.hs
+++ b/libs/hscim/test/Test/FilterSpec.hs
@@ -34,9 +34,13 @@ import Web.Scim.AttrName
 import Web.Scim.Filter
 import Web.Scim.Schema.Schema (Schema (..))
 import Web.Scim.Schema.User (NoUserExtra)
-import Web.Scim.Schema.UserTypes (UserTypes (supportedSchemas))
+import Web.Scim.Schema.UserTypes
 import Web.Scim.Test.Util (TestTag)
 
+spec :: Spec
+spec = pure ()
+
+{-
 prop_roundtrip :: forall tag. (UserTypes tag) => Property
 prop_roundtrip = property $ do
   x <- forAll $ genFilter @tag
@@ -350,3 +354,4 @@ genFilter =
   Gen.choice
     [ FilterAttrCompare <$> (genAttrPath @tag) <*> genCompareOp <*> genCompValue
     ]
+-}
diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
index 31dfc432c9..91b0d434d4 100644
--- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs
+++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 -- This file is part of the Wire Server implementation.
@@ -25,20 +27,21 @@ module Test.Schema.PatchOpSpec where
 import Data.Aeson
 import qualified Data.Aeson.Diff as AD
 import qualified Data.Aeson.KeyMap as KeyMap
-import qualified Data.Aeson.Pointer as AD
 import Data.Aeson.QQ (aesonQQ)
-import Data.Aeson.Types
-import Data.Either
-import qualified Data.List.NonEmpty as NE
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
 import Imports
 import Test.Hspec
 import Test.Hspec.QuickCheck
 import Test.QuickCheck
+import Text.Email.Parser
 import Web.Scim.AttrName
 import Web.Scim.Filter
+import Web.Scim.Schema.Common
 import Web.Scim.Schema.PatchOp
 import Web.Scim.Schema.Schema
 import Web.Scim.Schema.User
+import Web.Scim.Schema.User.Email
 import Web.Scim.Test.Util
 
 type PatchTag = TestTag Text () () UserExtraPatch
@@ -53,7 +56,11 @@ spec = do
           check (hs, js) = Right (toJSON hs) `shouldBe` lowerAllCaseInsensitiveThingsInPatch js
 
       check
-        `mapM_` [ ( Patch [PatchOpAdd (Just $ AttrPath Nothing (AttrName "userName") Nothing) (String "testuser")],
+        `mapM_` [ ( Patch
+                      [ PatchOpAdd
+                          (Just (ValuePath (topLevelAttrPath "userName") Nothing))
+                          (String "testuser")
+                      ],
                     [aesonQQ|
                     { "schemaS": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                       "operATIONS": [
@@ -76,7 +83,10 @@ spec = do
                     }
                     |]
                   ),
-                  ( Patch [PatchOpRemove (AttrPath (Just User20) (AttrName "userName") Nothing)],
+                  ( Patch
+                      [ PatchOpRemove
+                          (ValuePath (AttrPath (Just User20) (AttrName "userName") Nothing) Nothing)
+                      ],
                     [aesonQQ|
                     { "Schemas": ["urn:ietf:params:scim:api:messages:2.0:PatchOp"],
                       "Operations": [
@@ -90,10 +100,24 @@ spec = do
                 ]
 
   describe "applyPatch" $ do
+    focus . prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
+      \(barbie :: User PatchTag) (changedWant :: User PatchTag) ->
+        let patchOp :: Patch PatchTag
+            patchOp =
+              jsonPatchToScimPatch (AD.diff (toJSON barbie) (toJSON changedWant)) (toJSON barbie)
+                & either (error . show) Imports.id
+
+            go =
+              let j = scimPatchToJsonPatch patchOp (toJSON barbie)
+               in jsonPatchToScimPatch j (toJSON barbie)
+         in go === Right patchOp
+
     prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
-      \(barbie :: User (TestTag Text () () NoUserExtra)) changedWant ->
-        let patchOp :: Patch (TestTag Text () () NoUserExtra)
-            patchOp = todo -- PatchOp (AD.diff (toJSON barbie) (toJSON changedWant))
+      \(barbie :: User PatchTag) changedWant ->
+        let patchOp :: Patch PatchTag
+            patchOp =
+              jsonPatchToScimPatch (AD.diff (toJSON barbie) (toJSON changedWant)) (toJSON barbie)
+                & either (error . show) Imports.id
          in applyPatch patchOp barbie === Right changedWant
 
     it "throws expected error when patched object doesn't parse" $ do
@@ -109,14 +133,22 @@ spec = do
       _ <- todo
       True `shouldBe` False
 
-instance Arbitrary (User (TestTag Text () () NoUserExtra)) where
-  -- TODO: move this to test module in library.
-  arbitrary =
-    {-  do
-      userName <- undefined -- Gen.text (Range.constant 1 20) Gen.unicode
-      externalId <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
-      displayName <- undefined -- Gen.maybe $ Gen.text (Range.constant 0 20) Gen.unicode
-      active <- undefined -- Gen.maybe $ ScimBool <$> Gen.bool
-      pure (empty [User20] userName NoUserExtra) {externalId = externalId}
-     -}
-    undefined
+----------------------------------------------------------------------
+-- Arbitrary -- TODO: move to Web.Scim.Test.Something
+
+instance Arbitrary (User PatchTag) where
+  arbitrary = do
+    userName <- T.pack <$> listOf1 arbitrary
+    externalId <- oneof [pure Nothing, Just . T.pack <$> listOf1 arbitrary]
+    displayName <- oneof [pure Nothing, Just . T.pack <$> listOf1 arbitrary]
+    active <- ScimBool <$$> arbitrary
+    emails <- listOf arbitrary
+    roles <- T.pack <$$> listOf1 arbitrary
+    pure (empty @PatchTag [User20] userName mempty) {externalId, displayName, active, emails, roles}
+
+instance Arbitrary Email where
+  arbitrary = do
+    typ <- elements (Nothing : (Just <$> ["work", "mobile", "yellow"]))
+    value <- EmailAddress . (`unsafeEmailAddress` "example.com") . BS.pack <$> listOf1 arbitrary
+    primary <- ScimBool <$$> arbitrary
+    pure Email {..}
diff --git a/libs/hscim/test/Test/Schema/UserSpec.hs b/libs/hscim/test/Test/Schema/UserSpec.hs
index ce7635be4f..69eb6f4fde 100644
--- a/libs/hscim/test/Test/Schema/UserSpec.hs
+++ b/libs/hscim/test/Test/Schema/UserSpec.hs
@@ -27,28 +27,23 @@ where
 
 import Data.Aeson
 import qualified Data.Aeson.KeyMap as KeyMap
-import Data.Either (isLeft, isRight)
-import Data.Foldable (for_)
-import Data.Text (Text)
 import HaskellWorks.Hspec.Hedgehog (require)
 import Hedgehog
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 import Imports
-import Lens.Micro
 import Network.URI.Static (uri)
 import Test.Hspec
 import Test.Schema.Util (genUri, mk_prop_caseInsensitive)
 import Text.Email.Validate (emailAddress, validate)
+import Web.Scim.AttrName
 import qualified Web.Scim.Class.User as UserClass
-import Web.Scim.Filter (AttrPath (..))
+import Web.Scim.Filter
 import Web.Scim.Schema.Common (ScimBool (ScimBool), URI (..), WithId (..), prsJsonLower)
 import qualified Web.Scim.Schema.ListResponse as ListResponse
 import Web.Scim.Schema.Meta (ETag (Strong, Weak), Meta (..), WithMeta (..))
 import Web.Scim.Schema.PatchOp
-import qualified Web.Scim.Schema.PatchOp as PatchOp
 import Web.Scim.Schema.Schema
-import Web.Scim.Schema.Schema (Schema (..))
 import Web.Scim.Schema.User (NoUserExtra (..), User (..))
 import qualified Web.Scim.Schema.User as User
 import Web.Scim.Schema.User.Address as Address
@@ -114,10 +109,14 @@ spec = do
           ("externalid", String "lol"),
           ("active", Bool True)
         ]
-        $ \(key, upd) -> do
-          let operation = Operation Replace (Just (NormalPath (AttrPath Nothing key Nothing))) (Just upd)
-          let patchOp = PatchOp [operation]
-          User.applyPatch user patchOp `shouldSatisfy` isRight
+        $ \(key :: Text, newValue) -> do
+          let patchOp :: Patch PatchTag = Patch [operation]
+              operation =
+                PatchOpReplace
+                  (Just (ValuePath (AttrPath Nothing (AttrName key) Nothing) Nothing))
+                  newValue
+          applyPatch patchOp user `shouldSatisfy` isRight
+
     it "does not support multi-value attributes" $ do
       let schemas' = []
       let extras = KeyMap.empty
@@ -140,18 +139,20 @@ spec = do
           ("entitlements", toJSON @[Text] mempty),
           ("x509Certificates", toJSON @[Certificate] mempty)
         ]
-        $ \(key, upd) -> do
-          let operation = Operation Replace (Just (NormalPath (AttrPath Nothing key Nothing))) (Just upd)
-          let patchOp = PatchOp [operation]
-          User.applyPatch user patchOp `shouldSatisfy` isLeft
+        $ \(_key :: String, _upd) -> do
+          let patchOp :: Patch PatchTag = todo -- PatchOp [operation]
+          -- let operation = todo -- Operation Replace (Just (NormalPath (AttrPath Nothing key Nothing))) (Just upd)
+          applyPatch patchOp user `shouldSatisfy` isLeft
+
     it "applies patch to `extra`" $ do
       let schemas' = []
       let extras = KeyMap.empty
       let user :: User PatchTag = User.empty schemas' "hello" extras
-      let Right programmingLanguagePath = PatchOp.parsePath (User.supportedSchemas @PatchTag) "urn:hscim:test:programmingLanguage"
-      let operation = Operation Replace (Just programmingLanguagePath) (Just (toJSON @Text "haskell"))
-      let patchOp = PatchOp [operation]
-      User.extra <$> User.applyPatch user patchOp `shouldBe` Right (KeyMap.singleton "programmingLanguage" "haskell")
+      let Right _programmingLanguagePath = todo -- User.parsePath (User.supportedSchemas @PatchTag) "urn:hscim:test:programmingLanguage"
+      -- let operation = todo -- Operation Replace (Just programmingLanguagePath) (Just (toJSON @Text "haskell"))
+      let patchOp :: Patch PatchTag = todo -- PatchOp [operation]
+      User.extra <$> applyPatch patchOp user `shouldBe` Right (KeyMap.singleton "programmingLanguage" "haskell")
+
   describe "JSON serialization" $ do
     it "handles all fields" $ do
       require prop_roundtrip
@@ -474,12 +475,12 @@ data UserExtraTest = UserExtraEmpty | UserExtraObject {test :: Text}
   deriving (Show, Eq)
 
 instance FromJSON UserExtraTest where
-  parseJSON = withObject "UserExtraObject" $ \(lowercase -> o) -> do
-    o .:? "urn:hscim:test" >>= \case
-      Nothing -> pure UserExtraEmpty
-      Just (lowercase -> o2) -> UserExtraObject <$> o2 .: "test"
+  parseJSON = prsJsonLower >=> prs
     where
-      lowercase = KeyMap.fromList . map (over _1 lowerKey) . KeyMap.toList
+      prs = withObject "UserExtraObject" $ \o -> do
+        o .:? "urn:hscim:test" >>= \case
+          Nothing -> pure UserExtraEmpty
+          Just o2 -> UserExtraObject <$> o2 .: "test"
 
 instance ToJSON UserExtraTest where
   toJSON UserExtraEmpty = object []

From 696ad587e3868ce1a66a0fb5834c3381549866c8 Mon Sep 17 00:00:00 2001
From: Leif Battermann <leif.battermann@wire.com>
Date: Tue, 6 Jan 2026 11:15:01 +0000
Subject: [PATCH 11/13] arrFilterToIndices and arrIndexToFilter and roundtrip
 test

---
 libs/hscim/default.nix                     |   3 +
 libs/hscim/hscim.cabal                     |   3 +
 libs/hscim/src/Web/Scim/Schema/PatchOp.hs  | 128 ++++++++++++++++++++-
 libs/hscim/src/Web/Scim/Schema/Schema.hs   |   4 +-
 libs/hscim/test/Test/Schema/PatchOpSpec.hs |  68 ++++++++++-
 5 files changed, 200 insertions(+), 6 deletions(-)

diff --git a/libs/hscim/default.nix b/libs/hscim/default.nix
index 3ff763e9a1..25dd43c5a0 100644
--- a/libs/hscim/default.nix
+++ b/libs/hscim/default.nix
@@ -99,6 +99,7 @@ mkDerivation {
     time
     utf8-string
     uuid
+    vector
     wai
     wai-extra
     wai-utilities
@@ -119,6 +120,7 @@ mkDerivation {
     attoparsec
     base
     bytestring
+    case-insensitive
     email-validate
     hedgehog
     hspec
@@ -133,6 +135,7 @@ mkDerivation {
     microlens
     network-uri
     QuickCheck
+    scientific
     servant
     servant-server
     stm-containers
diff --git a/libs/hscim/hscim.cabal b/libs/hscim/hscim.cabal
index 956f552058..2e13fcbdbb 100644
--- a/libs/hscim/hscim.cabal
+++ b/libs/hscim/hscim.cabal
@@ -78,6 +78,7 @@ library
     OverloadedStrings
     RankNTypes
     ScopedTypeVariables
+    TupleSections
     TypeApplications
     TypeFamilies
     TypeOperators
@@ -219,6 +220,7 @@ test-suite spec
     , attoparsec
     , base
     , bytestring
+    , case-insensitive
     , email-validate
     , hedgehog
     , hscim
@@ -234,6 +236,7 @@ test-suite spec
     , microlens
     , network-uri
     , QuickCheck
+    , scientific
     , servant
     , servant-server
     , stm-containers
diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
index 18529f3240..fa0a2d905c 100644
--- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
+++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
@@ -25,7 +25,9 @@ import qualified Data.Aeson.KeyMap as AK
 import qualified Data.Aeson.Patch as AD
 import qualified Data.Aeson.Pointer as AD
 import Data.Aeson.Types
+import qualified Data.CaseInsensitive as CI
 import Data.Proxy (Proxy (Proxy))
+import Data.Scientific (Scientific)
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text as Text
@@ -115,15 +117,86 @@ scimPatchToJsonPatch (Patch scimOps) jsonOrig = do
       where
         nm@(AD.OKey key) = AD.OKey . AK.fromText . rAttrName $ name
         arr = case jsonOrig of
-          Object obj -> case AK.lookup key obj of
+          Object obj -> case lookupKeyCI key obj of
             Just (Array vec) -> V.toList vec
             _ -> todo
           _ -> todo
         ixToValPaths :: Int -> AD.Pointer
         ixToValPaths ix = todo
+        lookupKeyCI :: AK.Key -> AK.KeyMap Value -> Maybe Value
+        lookupKeyCI target obj =
+          let target' = CI.foldCase (AK.toText target)
+           in snd
+                <$> find
+                  (\(k, _) -> CI.foldCase (AK.toText k) == target')
+                  (AK.toList obj)
 
 arrFilterToIndices :: Filter -> [Value] -> [Int]
-arrFilterToIndices _ _ = todo
+arrFilterToIndices filter arr =
+  [ix | (ix, val) <- zip [0 ..] arr, matches val]
+  where
+    matches :: Value -> Bool
+    matches val = case filter of
+      FilterAttrCompare attr op compVal ->
+        maybe False (compareValue op compVal) (attrValue attr val)
+
+    attrValue :: AttrPath -> Value -> Maybe Value
+    attrValue (AttrPath _ name mbSub) val = case mbSub of
+      Nothing -> lookupAttr name val
+      Just (SubAttr subName) -> do
+        obj <- asObject val
+        top <- lookupAttrInObject name obj
+        subObj <- asObject top
+        lookupAttrInObject subName subObj
+
+    lookupAttr :: AttrName -> Value -> Maybe Value
+    lookupAttr name val = case val of
+      Object obj -> lookupAttrInObject name obj
+      -- e.g. roles[value eq "admin"]
+      _ | name == "value" -> Just val
+      _ -> Nothing
+
+    lookupAttrInObject :: AttrName -> AK.KeyMap Value -> Maybe Value
+    lookupAttrInObject name obj =
+      let target = CI.foldCase (rAttrName name)
+       in snd <$> find (\(key, _) -> CI.foldCase (AK.toText key) == target) (AK.toList obj)
+
+    asObject :: Value -> Maybe (AK.KeyMap Value)
+    asObject = \case
+      Object obj -> Just obj
+      _ -> Nothing
+
+    compareValue :: CompareOp -> CompValue -> Value -> Bool
+    compareValue op compVal val = case (compVal, val) of
+      (ValString s, String t) -> compareStr op (CI.foldCase t) (CI.foldCase s)
+      (ValNumber s, Number t) -> compareNumber op t s
+      (ValBool s, Bool t) -> compareBool op t s
+      (ValNull, Null) -> compareNull op
+      _ -> False
+
+    compareNumber :: CompareOp -> Scientific -> Scientific -> Bool
+    compareNumber = \case
+      OpEq -> (==)
+      OpNe -> (/=)
+      OpGt -> (>)
+      OpGe -> (>=)
+      OpLt -> (<)
+      OpLe -> (<=)
+      OpCo -> \_ _ -> False
+      OpSw -> \_ _ -> False
+      OpEw -> \_ _ -> False
+
+    compareBool :: CompareOp -> Bool -> Bool -> Bool
+    compareBool op a b = case op of
+      OpEq -> a == b
+      OpNe -> a /= b
+      _ -> False
+
+    compareNull :: CompareOp -> Bool
+    compareNull = \case
+      OpEq -> True
+      OpNe -> False
+      _ -> False
 
 -- | The inverse of `jsonPatchToScimPatch`.  This does not validate
 -- schemas, and never fills the schema argument of `AttrPath`.  See
@@ -159,7 +232,56 @@ jsonPatchToScimPatch jsonPatch jsonOrig = do
     mapPath bad = throwError $ "illegal or unsupported attribute path: " <> show bad
 
 arrIndexToFilter :: Int -> [Value] -> Filter
-arrIndexToFilter _ _ = todo
+arrIndexToFilter ix arr = case drop ix arr of
+  [] -> todo
+  (val : _) -> valToFilter val
+  where
+    valToFilter :: Value -> Filter
+    valToFilter = \case
+      Object obj -> objectToFilter obj
+      other ->
+        FilterAttrCompare
+          (AttrPath Nothing "value" Nothing)
+          OpEq
+          (valueToCompValue other)
+
+    objectToFilter :: AK.KeyMap Value -> Filter
+    objectToFilter obj =
+      case lookupPrimitiveKeyCI "value" obj <|> firstPrimitiveKey obj of
+        Just (name, compVal) ->
+          FilterAttrCompare (AttrPath Nothing name Nothing) OpEq compVal
+        Nothing -> todo
+
+    lookupPrimitiveKeyCI :: Text -> AK.KeyMap Value -> Maybe (AttrName, CompValue)
+    lookupPrimitiveKeyCI target obj =
+      let target' = CI.foldCase target
+       in listToMaybe $
+            mapMaybe
+              ( \(k, v) ->
+                  if CI.foldCase (AK.toText k) == target'
+                    then (AttrName (AK.toText k),) <$> valueToCompValueMaybe v
+                    else Nothing
+              )
+              (AK.toList obj)
+
+    firstPrimitiveKey :: AK.KeyMap Value -> Maybe (AttrName, CompValue)
+    firstPrimitiveKey obj =
+      listToMaybe $
+        mapMaybe
+          (\(k, v) -> (AttrName (AK.toText k),) <$> valueToCompValueMaybe v)
+          (AK.toList obj)
+
+    valueToCompValue :: Value -> CompValue
+    valueToCompValue val =
+      fromMaybe todo (valueToCompValueMaybe val)
+
+    valueToCompValueMaybe :: Value -> Maybe CompValue
+    valueToCompValueMaybe = \case
+      String s -> Just (ValString s)
+      Number n -> Just (ValNumber n)
+      Bool b -> Just (ValBool b)
+      Null -> Just ValNull
+      _ -> Nothing
 
 emptyPath :: AD.Pointer
 emptyPath =
diff --git a/libs/hscim/src/Web/Scim/Schema/Schema.hs b/libs/hscim/src/Web/Scim/Schema/Schema.hs
index 1ad87d44a7..504fd455a2 100644
--- a/libs/hscim/src/Web/Scim/Schema/Schema.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Schema.hs
@@ -100,8 +100,8 @@ getSchemaUri (CustomSchema x) =
 -- that is literally insane. Won't implement.
 pSchema :: [Schema] -> Parser Schema
 pSchema supported =
-  Parser.choice
-    $ map (\s -> fromSchemaUri . decodeUtf8 <$> Parser.string (encodeUtf8 $ getSchemaUri s)) supported
+  Parser.choice $
+    map (\s -> fromSchemaUri . decodeUtf8 <$> Parser.string (encodeUtf8 $ getSchemaUri s)) supported
 
 -- | Get a schema by its URI.
 --
diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
index 91b0d434d4..b30977d8a5 100644
--- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs
+++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
@@ -29,6 +29,8 @@ import qualified Data.Aeson.Diff as AD
 import qualified Data.Aeson.KeyMap as KeyMap
 import Data.Aeson.QQ (aesonQQ)
 import qualified Data.ByteString as BS
+import qualified Data.CaseInsensitive as CI
+import Data.Scientific (Scientific, scientific)
 import qualified Data.Text as T
 import Imports
 import Test.Hspec
@@ -100,7 +102,7 @@ spec = do
                 ]
 
   describe "applyPatch" $ do
-    focus . prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
+    prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
       \(barbie :: User PatchTag) (changedWant :: User PatchTag) ->
         let patchOp :: Patch PatchTag
             patchOp =
@@ -120,6 +122,13 @@ spec = do
                 & either (error . show) Imports.id
          in applyPatch patchOp barbie === Right changedWant
 
+    focus . prop "arrFilterToIndices/arrIndexToFilter roundtrip on singleton match" $
+      forAll genArrFilterCase $ \(arr, fltr, ix) ->
+        let indices = arrFilterToIndices fltr arr
+            fltr' = arrIndexToFilter ix arr
+         in indices === [ix]
+              .&&. arrFilterToIndices fltr' arr === indices
+
     it "throws expected error when patched object doesn't parse" $ do
       () <- todo
       True `shouldBe` False
@@ -152,3 +161,60 @@ instance Arbitrary Email where
     value <- EmailAddress . (`unsafeEmailAddress` "example.com") . BS.pack <$> listOf1 arbitrary
     primary <- ScimBool <$$> arbitrary
     pure Email {..}
+
+genArrFilterCase :: Gen ([Value], Filter, Int)
+genArrFilterCase = do
+  compVal <- genCompValue
+  let fltr = FilterAttrCompare (AttrPath Nothing "value" Nothing) OpEq compVal
+  useObject <- arbitrary
+  keyVariant <- elements ["value", "VALUE", "Value"]
+  let matchingValue =
+        if useObject
+          then Object (KeyMap.singleton keyVariant (compValueToValue compVal))
+          else compValueToValue compVal
+  prefix <- listOf (genNonMatchingValue compVal)
+  suffix <- listOf (genNonMatchingValue compVal)
+  let ix = length prefix
+  pure (prefix <> [matchingValue] <> suffix, fltr, ix)
+
+genCompValue :: Gen CompValue
+genCompValue =
+  oneof
+    [ ValString <$> genText,
+      ValNumber <$> genScientific,
+      ValBool <$> arbitrary,
+      pure ValNull
+    ]
+
+genNonMatchingValue :: CompValue -> Gen Value
+genNonMatchingValue compVal = oneof [genPrimitive, genObject]
+  where
+    genPrimitive = compValueToValue <$> genDifferentCompValue compVal
+    genObject = do
+      keyVariant <- elements ["value", "VALUE", "Value"]
+      val <- compValueToValue <$> genDifferentCompValue compVal
+      pure (Object (KeyMap.singleton keyVariant val))
+
+genDifferentCompValue :: CompValue -> Gen CompValue
+genDifferentCompValue compVal = case compVal of
+  ValString s ->
+    ValString <$> suchThat genText (\t -> CI.foldCase t /= CI.foldCase s)
+  ValNumber n -> ValNumber <$> suchThat genScientific (/= n)
+  ValBool b -> pure (ValBool (not b))
+  ValNull -> oneof [ValBool <$> arbitrary, ValNumber <$> genScientific, ValString <$> genText]
+
+compValueToValue :: CompValue -> Value
+compValueToValue = \case
+  ValNull -> Null
+  ValBool b -> Bool b
+  ValNumber n -> Number n
+  ValString s -> String s
+
+genText :: Gen Text
+genText = T.pack <$> listOf1 (elements (['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9']))
+
+genScientific :: Gen Scientific
+genScientific = do
+  coeff <- arbitrary :: Gen Integer
+  exp10 <- chooseInt (-6, 6)
+  pure (scientific coeff exp10)

From c625891b2877db6efc45e544791cce94613ab0d0 Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 6 Jan 2026 14:10:59 +0100
Subject: [PATCH 12/13] Cleanup haddocks.

---
 libs/hscim/src/Web/Scim/Schema/Common.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/libs/hscim/src/Web/Scim/Schema/Common.hs b/libs/hscim/src/Web/Scim/Schema/Common.hs
index c174f88e47..1aaa425a1f 100644
--- a/libs/hscim/src/Web/Scim/Schema/Common.hs
+++ b/libs/hscim/src/Web/Scim/Schema/Common.hs
@@ -106,10 +106,9 @@ parseOptions =
 -- 'Data.CaseInsensitive.foldCase'.  They're not all the same thing!
 -- https://github.com/basvandijk/case-insensitive/issues/31
 --
--- NB: The "recursively" part is mostly redundant: to make the code
--- more robust, we also call `jsonLower` in all relevant `FromJSON`
--- instances.  But recursing anyway is more robust, and recursion
--- depth is <= 2.
+-- NB: The "recursively" part is at least partially redundant because
+-- we call `jsonLower` in all `FromJSON` instances, but we don't care
+-- about the overhead because scim objects are never that deep.
 jsonLower :: forall m. (MonadError String m) => Value -> m Value
 jsonLower (Object (KeyMap.toList -> olist)) =
   Object . KeyMap.fromList <$> (nubCI >> mapM lowerPair olist)

From a7fa1ce0c8dce62be515e694a9e030c758c230aa Mon Sep 17 00:00:00 2001
From: Matthias Fischmann <mf@zerobuzz.net>
Date: Tue, 6 Jan 2026 14:14:40 +0100
Subject: [PATCH 13/13] Translate scim to json patches and back [WIP].

---
 libs/hscim/src/Web/Scim/Schema/PatchOp.hs  | 115 +++++++++++++--------
 libs/hscim/test/Test/Schema/PatchOpSpec.hs |  26 ++---
 2 files changed, 83 insertions(+), 58 deletions(-)

diff --git a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
index fa0a2d905c..51497ec5d6 100644
--- a/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
+++ b/libs/hscim/src/Web/Scim/Schema/PatchOp.hs
@@ -17,7 +17,7 @@
 
 module Web.Scim.Schema.PatchOp where
 
-import Control.Monad.Error.Class (MonadError, throwError)
+import Control.Monad.Error.Class
 import Data.Aeson
 import qualified Data.Aeson.Diff as AD
 import qualified Data.Aeson.Key as AK
@@ -92,51 +92,52 @@ data PatchOp tag
 --
 -- Scim schema information in `AttrName`s is ignored (`AD.Patch` does
 -- not do schema validation).
-scimPatchToJsonPatch :: forall tag. Patch tag -> Value -> AD.Patch
+scimPatchToJsonPatch :: forall tag m. (MonadError ScimError m) => Patch tag -> Value -> m AD.Patch
 scimPatchToJsonPatch (Patch scimOps) jsonOrig = do
-  AD.Patch (concat (mapOp <$> scimOps))
+  jsonOps <- do
+    let err = throwError . badRequest InvalidValue . Just . Text.pack
+    (mapOp `mapM` scimOps) & either err pure
+  pure $ AD.Patch jsonOps
   where
-    mapOp :: PatchOp tag -> [AD.Operation]
+    mapOp :: PatchOp tag -> Either String AD.Operation
     mapOp = \case
       PatchOpAdd mbAttrPath val -> (`AD.Add` val) <$> mapPath mbAttrPath
       PatchOpRemove attrPath -> AD.Rem <$> mapPath (Just attrPath)
       PatchOpReplace mbAttrPath val -> (`AD.Rep` val) <$> mapPath mbAttrPath
 
-    mapPath :: Maybe ValuePath -> [AD.Pointer]
-    mapPath Nothing = [emptyPath]
+    mapPath :: Maybe ValuePath -> Either String AD.Pointer
+    mapPath Nothing = pure emptyPath
     mapPath (Just (ValuePath (AttrPath _mbSchema name mbSub) Nothing)) =
-      [AD.Pointer (nm : sub)]
+      pure (AD.Pointer (nm : sub))
       where
         nm = AD.OKey . AK.fromText . rAttrName $ name
         sub = [AD.OKey . AK.fromText . rAttrName $ subName | SubAttr subName <- maybeToList mbSub]
     mapPath (Just (ValuePath (AttrPath _mbSchema name Nothing) mbFilter)) =
-      [AD.Pointer [nm]]
-        <> case mbFilter of
-          Nothing -> []
-          Just fltr -> ixToValPaths <$> arrFilterToIndices fltr arr
+      AD.Pointer <$> ((nm :) <$> fltr)
       where
-        nm@(AD.OKey key) = AD.OKey . AK.fromText . rAttrName $ name
-        arr = case jsonOrig of
-          Object obj -> case lookupKeyCI key obj of
-            Just (Array vec) -> V.toList vec
-            _ -> todo
-          _ -> todo
-        ixToValPaths :: Int -> AD.Pointer
-        ixToValPaths ix = todo
-        lookupKeyCI :: AK.Key -> AK.KeyMap Value -> Maybe Value
-        lookupKeyCI target obj =
-          let target' = CI.foldCase (AK.toText target)
-           in snd
-                <$> find
-                  (\(k, _) -> CI.foldCase (AK.toText k) == target')
-                  (AK.toList obj)
+        key = AK.fromText (rAttrName name)
+        nm = AD.OKey key
+
+        fltr :: Either String [AD.Key]
+        fltr = case mbFilter of
+          Nothing -> pure []
+          Just fl -> do
+            arr <- case jsonOrig of
+              Object obj -> case AK.lookup key obj of
+                Just (Array vec) -> pure $ V.toList vec
+                _ -> throwError $ AK.toString key <> " does not point to an object"
+              _ -> throwError $ "not an object"
+            let mkPointer ix = AD.AKey ix
+            pure $ mkPointer <$> arrFilterToIndices fl arr
+    mapPath bad =
+      throwError $ "scimPatchToJsonPatch: illegal or unsupported attribute path: " <> show bad
 
 arrFilterToIndices :: Filter -> [Value] -> [Int]
-arrFilterToIndices filter arr =
+arrFilterToIndices fltr arr =
   [ix | (ix, val) <- zip [0 ..] arr, matches val]
   where
     matches :: Value -> Bool
-    matches val = case filter of
+    matches val = case fltr of
       FilterAttrCompare attr op compVal ->
         maybe False (compareValue op compVal) (attrValue attr val)
 
@@ -202,34 +203,58 @@ arrFilterToIndices filter arr =
 -- schemas, and never fills the schema argument of `AttrPath`.  See
 -- haddocks of `Patch` above.  Since `AD.Patch` is more expressive
 -- than `Patch`, this can have errors.
-jsonPatchToScimPatch :: forall tag m. (MonadError String m) => AD.Patch -> Value -> m (Patch tag)
+jsonPatchToScimPatch :: forall tag m. (MonadError ScimError m) => AD.Patch -> Value -> m (Patch tag)
 jsonPatchToScimPatch jsonPatch jsonOrig = do
-  (mapOp `mapM` (AD.patchOperations jsonPatch)) <&> Patch
+  ops <- do
+    let err = throwError . badRequest InvalidValue . Just . Text.pack
+    (mapOp `mapM` AD.patchOperations jsonPatch) & either err pure
+  pure $ Patch ops
   where
-    mapOp :: AD.Operation -> m (PatchOp tag)
+    mapOp :: AD.Operation -> Either String (PatchOp tag)
     mapOp = \case
-      AD.Add path val -> (`PatchOpAdd` val) <$> mapPath path
-      AD.Rem path -> mapPath path >>= maybe (throwError "remove op requires path argument.") (pure . PatchOpRemove)
-      AD.Rep path val -> (`PatchOpReplace` val) <$> mapPath path
+      AD.Add path val -> (`PatchOpAdd` val) <$> mapPath (traceShowId path)
+      AD.Rem path -> traceShowId (mapPath path) >>= maybe (throwError "remove op requires path argument.") (pure . PatchOpRemove)
+      AD.Rep path val -> (`PatchOpReplace` val) <$> mapPath (traceShowId path)
       AD.Mov {} -> throwError "unsupported patch operation: mov"
       AD.Cpy {} -> throwError "unsupported patch operation: cpy"
       AD.Tst {} -> throwError "unsupported patch operation: tst"
 
-    mapPath :: AD.Pointer -> m (Maybe ValuePath)
+    mapPath :: AD.Pointer -> Either String (Maybe ValuePath)
     mapPath (AD.Pointer []) = pure Nothing
     mapPath (AD.Pointer [AD.OKey key]) = pure $ Just (ValuePath (topLevelAttrPath (AK.toText key)) Nothing)
     mapPath (AD.Pointer [AD.OKey key, AD.OKey sub]) = todo key sub
     mapPath (AD.Pointer [AD.OKey key, AD.AKey ix]) = do
+      arr <- case jsonOrig of
+        Object obj -> case AK.lookup key obj of
+          Just (Array vec) -> pure $ V.toList vec
+          _ -> throwError $ AK.toString key <> " does not point to an object"
+        _ -> throwError $ "not an object"
       let fltr = arrIndexToFilter ix arr
-          arr = case jsonOrig of
-            Object obj -> case AK.lookup key obj of
-              Just (Array vec) -> V.toList vec
-              _ -> todo
-            _ -> todo
           attr = topLevelAttrPath (AK.toText key)
       pure $ Just (ValuePath attr (Just fltr))
-    mapPath (AD.Pointer [AD.OKey key, AD.AKey ix, AD.OKey sub]) = todo key ix sub
-    mapPath bad = throwError $ "illegal or unsupported attribute path: " <> show bad
+    mapPath (AD.Pointer [AD.OKey key, AD.AKey ix, AD.OKey subKey]) = do
+      _
+    mapPath bad = do
+      throwError $ "jsonPatchToScimPatch: illegal or unsupported attribute path: " <> show bad
+
+{-
+
+{emails: [{val: me@me.com, typ: work}, {val: you@you.com, typ: work}]}
+
+emails[1].val
+
+emails[val=you@you.com]
+
+-}
+
+_
+
+-- we don't need diff in production!  this is really good, because
+-- diff works very differently between scim and json.  so we just need
+-- to rip out everything related to diff here, and either copy it to
+-- tests and keep on hacking, or copy diff from aeson-diff to the
+-- tests and hack that, or just write a few unit tests instead of the
+-- property.
 
 arrIndexToFilter :: Int -> [Value] -> Filter
 arrIndexToFilter ix arr = case drop ix arr of
@@ -377,12 +402,12 @@ applyPatch ::
   a ->
   m a
 applyPatch scimPatch (toJSON -> jsonOrig) = do
-  let jsonPatch = scimPatchToJsonPatch scimPatch jsonOrig
-
-      result err = \case
+  let result err = \case
         Success val -> pure val
         Error txt -> throwError . badRequest InvalidValue . Just . err $ Text.pack txt
 
+  jsonPatch <- scimPatchToJsonPatch scimPatch jsonOrig
+
   jsonPatched <-
     AD.patch jsonPatch jsonOrig
       & result ("could not apply patch: " <>)
diff --git a/libs/hscim/test/Test/Schema/PatchOpSpec.hs b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
index b30977d8a5..83b4a95c1b 100644
--- a/libs/hscim/test/Test/Schema/PatchOpSpec.hs
+++ b/libs/hscim/test/Test/Schema/PatchOpSpec.hs
@@ -102,16 +102,23 @@ spec = do
                 ]
 
   describe "applyPatch" $ do
-    prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
-      \(barbie :: User PatchTag) (changedWant :: User PatchTag) ->
+    focus . prop "arrFilterToIndices/arrIndexToFilter roundtrip on singleton match" $
+      forAll genArrFilterCase $ \(arr, fltr, ix) ->
+        let indices = arrFilterToIndices fltr arr
+            fltr' = arrIndexToFilter ix arr
+         in indices === [ix]
+              .&&. arrFilterToIndices fltr' arr === indices
+
+    focus . prop "roundtrip: jsonPatchToScimPatch and back" $
+      \(oldBarbie :: User PatchTag) (newBarbie :: User PatchTag) ->
         let patchOp :: Patch PatchTag
             patchOp =
-              jsonPatchToScimPatch (AD.diff (toJSON barbie) (toJSON changedWant)) (toJSON barbie)
+              jsonPatchToScimPatch (AD.diff (toJSON oldBarbie) (toJSON newBarbie)) (toJSON oldBarbie)
                 & either (error . show) Imports.id
 
-            go =
-              let j = scimPatchToJsonPatch patchOp (toJSON barbie)
-               in jsonPatchToScimPatch j (toJSON barbie)
+            go = do
+              j <- scimPatchToJsonPatch patchOp (toJSON oldBarbie)
+              jsonPatchToScimPatch j (toJSON oldBarbie)
          in go === Right patchOp
 
     prop "roundtrip (generate two users/groups, diff them, apply the patch, compare)" $
@@ -122,13 +129,6 @@ spec = do
                 & either (error . show) Imports.id
          in applyPatch patchOp barbie === Right changedWant
 
-    focus . prop "arrFilterToIndices/arrIndexToFilter roundtrip on singleton match" $
-      forAll genArrFilterCase $ \(arr, fltr, ix) ->
-        let indices = arrFilterToIndices fltr arr
-            fltr' = arrIndexToFilter ix arr
-         in indices === [ix]
-              .&&. arrFilterToIndices fltr' arr === indices
-
     it "throws expected error when patched object doesn't parse" $ do
       () <- todo
       True `shouldBe` False