-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

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 Data.Bifunctor (first)
import qualified Data.CaseInsensitive as CI
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 Web.Scim.Schema.Error
import Web.Scim.Schema.Schema (Schema (PatchOp20))
import Web.Scim.Schema.UserTypes (UserTypes (supportedSchemas))

newtype PatchOp tag = PatchOp
  {forall tag. PatchOp tag -> [Operation]
getOperations :: [Operation]}
  deriving (PatchOp tag -> PatchOp tag -> Bool
(PatchOp tag -> PatchOp tag -> Bool)
-> (PatchOp tag -> PatchOp tag -> Bool) -> Eq (PatchOp tag)
forall tag. PatchOp tag -> PatchOp tag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tag. PatchOp tag -> PatchOp tag -> Bool
== :: PatchOp tag -> PatchOp tag -> Bool
$c/= :: forall tag. PatchOp tag -> PatchOp tag -> Bool
/= :: PatchOp tag -> PatchOp tag -> Bool
Eq, Int -> PatchOp tag -> ShowS
[PatchOp tag] -> ShowS
PatchOp tag -> String
(Int -> PatchOp tag -> ShowS)
-> (PatchOp tag -> String)
-> ([PatchOp tag] -> ShowS)
-> Show (PatchOp tag)
forall tag. Int -> PatchOp tag -> ShowS
forall tag. [PatchOp tag] -> ShowS
forall tag. PatchOp tag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tag. Int -> PatchOp tag -> ShowS
showsPrec :: Int -> PatchOp tag -> ShowS
$cshow :: forall tag. PatchOp tag -> String
show :: PatchOp tag -> String
$cshowList :: forall tag. [PatchOp tag] -> ShowS
showList :: [PatchOp tag] -> ShowS
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.
--
-- 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
  { Operation -> Op
op :: Op,
    Operation -> Maybe Path
path :: Maybe Path,
    Operation -> Maybe Value
value :: Maybe Value
  }
  deriving (Operation -> Operation -> Bool
(Operation -> Operation -> Bool)
-> (Operation -> Operation -> Bool) -> Eq Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
/= :: Operation -> Operation -> Bool
Eq, Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
(Int -> Operation -> ShowS)
-> (Operation -> String)
-> ([Operation] -> ShowS)
-> Show Operation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operation -> ShowS
showsPrec :: Int -> Operation -> ShowS
$cshow :: Operation -> String
show :: Operation -> String
$cshowList :: [Operation] -> ShowS
showList :: [Operation] -> ShowS
Show)

data Op
  = Add
  | Replace
  | Remove
  deriving (Op -> Op -> Bool
(Op -> Op -> Bool) -> (Op -> Op -> Bool) -> Eq Op
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Op -> Op -> Bool
== :: Op -> Op -> Bool
$c/= :: Op -> Op -> Bool
/= :: Op -> Op -> Bool
Eq, Int -> Op -> ShowS
[Op] -> ShowS
Op -> String
(Int -> Op -> ShowS)
-> (Op -> String) -> ([Op] -> ShowS) -> Show Op
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Op -> ShowS
showsPrec :: Int -> Op -> ShowS
$cshow :: Op -> String
show :: Op -> String
$cshowList :: [Op] -> ShowS
showList :: [Op] -> ShowS
Show, Int -> Op
Op -> Int
Op -> [Op]
Op -> Op
Op -> Op -> [Op]
Op -> Op -> Op -> [Op]
(Op -> Op)
-> (Op -> Op)
-> (Int -> Op)
-> (Op -> Int)
-> (Op -> [Op])
-> (Op -> Op -> [Op])
-> (Op -> Op -> [Op])
-> (Op -> Op -> Op -> [Op])
-> Enum Op
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Op -> Op
succ :: Op -> Op
$cpred :: Op -> Op
pred :: Op -> Op
$ctoEnum :: Int -> Op
toEnum :: Int -> Op
$cfromEnum :: Op -> Int
fromEnum :: Op -> Int
$cenumFrom :: Op -> [Op]
enumFrom :: Op -> [Op]
$cenumFromThen :: Op -> Op -> [Op]
enumFromThen :: Op -> Op -> [Op]
$cenumFromTo :: Op -> Op -> [Op]
enumFromTo :: Op -> Op -> [Op]
$cenumFromThenTo :: Op -> Op -> Op -> [Op]
enumFromThenTo :: Op -> Op -> Op -> [Op]
Enum, Op
Op -> Op -> Bounded Op
forall a. a -> a -> Bounded a
$cminBound :: Op
minBound :: Op
$cmaxBound :: Op
maxBound :: Op
Bounded)

-- | PATH = attrPath / valuePath [subAttr]
data Path
  = NormalPath AttrPath
  | IntoValuePath ValuePath (Maybe SubAttr)
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> String
show :: Path -> String
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show)

parsePath :: [Schema] -> Text -> Either String Path
parsePath :: [Schema] -> Text -> Either String Path
parsePath [Schema]
schemas' = Parser Path -> ByteString -> Either String Path
forall a. Parser a -> ByteString -> Either String a
parseOnly ([Schema] -> Parser Path
pPath [Schema]
schemas' Parser Path -> Parser ByteString () -> Parser Path
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput) (ByteString -> Either String Path)
-> (Text -> ByteString) -> Text -> Either String Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

-- | PATH = attrPath / valuePath [subAttr]
pPath :: [Schema] -> Parser Path
pPath :: [Schema] -> Parser Path
pPath [Schema]
schemas' =
  ValuePath -> Maybe SubAttr -> Path
IntoValuePath (ValuePath -> Maybe SubAttr -> Path)
-> Parser ByteString ValuePath
-> Parser ByteString (Maybe SubAttr -> Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Schema] -> Parser ByteString ValuePath
pValuePath [Schema]
schemas' Parser ByteString (Maybe SubAttr -> Path)
-> Parser ByteString (Maybe SubAttr) -> Parser Path
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString SubAttr -> Parser ByteString (Maybe SubAttr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString SubAttr
pSubAttr
    Parser Path -> Parser Path -> Parser Path
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AttrPath -> Path
NormalPath (AttrPath -> Path) -> Parser ByteString AttrPath -> Parser Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Schema] -> Parser ByteString AttrPath
pAttrPath [Schema]
schemas'

rPath :: Path -> Text
rPath :: Path -> Text
rPath (NormalPath AttrPath
attrPath) = AttrPath -> Text
rAttrPath AttrPath
attrPath
rPath (IntoValuePath ValuePath
valuePath Maybe SubAttr
subAttr) = ValuePath -> Text
rValuePath ValuePath
valuePath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (SubAttr -> Text) -> Maybe SubAttr -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" SubAttr -> Text
rSubAttr Maybe SubAttr
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 :: Value -> Parser (PatchOp tag)
parseJSON = String
-> (Object -> Parser (PatchOp tag))
-> Value
-> Parser (PatchOp tag)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PatchOp" ((Object -> Parser (PatchOp tag)) -> Value -> Parser (PatchOp tag))
-> (Object -> Parser (PatchOp tag))
-> Value
-> Parser (PatchOp tag)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    let o :: Object
o = [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Object)
-> (Object -> [(Key, Value)]) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Value) -> (Key, Value)) -> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Key) -> (Key, Value) -> (Key, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Key
lowerKey) ([(Key, Value)] -> [(Key, Value)])
-> (Object -> [(Key, Value)]) -> Object -> [(Key, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ Object
v
    [Schema]
schemas' :: [Schema] <- Object
o Object -> Key -> Parser [Schema]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schemas"
    Bool -> Parser ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser ()) -> Bool -> Parser ()
forall a b. (a -> b) -> a -> b
$ Schema
PatchOp20 Schema -> [Schema] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Schema]
schemas'
    [Operation]
operations <- (Value -> Parser [Operation])
-> Object -> Key -> Parser [Operation]
forall a. (Value -> Parser a) -> Object -> Key -> Parser a
Aeson.explicitParseField ((Value -> Parser Operation) -> Value -> Parser [Operation]
forall a. (Value -> Parser a) -> Value -> Parser [a]
Aeson.listParser ((Value -> Parser Operation) -> Value -> Parser [Operation])
-> (Value -> Parser Operation) -> Value -> Parser [Operation]
forall a b. (a -> b) -> a -> b
$ [Schema] -> Value -> Parser Operation
operationFromJSON (forall tag. UserTypes tag => [Schema]
supportedSchemas @tag)) Object
o Key
"operations"
    PatchOp tag -> Parser (PatchOp tag)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PatchOp tag -> Parser (PatchOp tag))
-> PatchOp tag -> Parser (PatchOp tag)
forall a b. (a -> b) -> a -> b
$ [Operation] -> PatchOp tag
forall tag. [Operation] -> PatchOp tag
PatchOp [Operation]
operations

instance ToJSON (PatchOp tag) where
  toJSON :: PatchOp tag -> Value
toJSON (PatchOp [Operation]
operations) =
    [(Key, Value)] -> Value
object [Key
"operations" Key -> [Operation] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= [Operation]
operations, Key
"schemas" Key -> [Schema] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= [Schema
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 :: [Schema] -> Value -> Parser Operation
operationFromJSON [Schema]
schemas' =
  String -> (Object -> Parser Operation) -> Value -> Parser Operation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Operation" ((Object -> Parser Operation) -> Value -> Parser Operation)
-> (Object -> Parser Operation) -> Value -> Parser Operation
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    let o :: Object
o = [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Object)
-> (Object -> [(Key, Value)]) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Value) -> (Key, Value)) -> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Key) -> (Key, Value) -> (Key, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Key
lowerKey) ([(Key, Value)] -> [(Key, Value)])
-> (Object -> [(Key, Value)]) -> Object -> [(Key, Value)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ Object
v
    Op -> Maybe Path -> Maybe Value -> Operation
Operation
      (Op -> Maybe Path -> Maybe Value -> Operation)
-> Parser Op -> Parser (Maybe Path -> Maybe Value -> Operation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Op
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"op")
      Parser (Maybe Path -> Maybe Value -> Operation)
-> Parser (Maybe Path) -> Parser (Maybe Value -> Operation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser Path) -> Object -> Key -> Parser (Maybe Path)
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
Aeson.explicitParseFieldMaybe ([Schema] -> Value -> Parser Path
pathFromJSON [Schema]
schemas') Object
o Key
"path"
      Parser (Maybe Value -> Operation)
-> Parser (Maybe Value) -> Parser Operation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"value")

pathFromJSON :: [Schema] -> Value -> Aeson.Parser Path
pathFromJSON :: [Schema] -> Value -> Parser Path
pathFromJSON [Schema]
schemas' =
  String -> (Text -> Parser Path) -> Value -> Parser Path
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Path" ((Text -> Parser Path) -> Value -> Parser Path)
-> (Text -> Parser Path) -> Value -> Parser Path
forall a b. (a -> b) -> a -> b
$ (String -> Parser Path)
-> (Path -> Parser Path) -> Either String Path -> Parser Path
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Path
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Path -> Parser Path
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Path -> Parser Path)
-> (Text -> Either String Path) -> Text -> Parser Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Schema] -> Text -> Either String Path
parsePath [Schema]
schemas'

instance ToJSON Operation where
  toJSON :: Operation -> Value
toJSON (Operation Op
op' Maybe Path
path' Maybe Value
value') =
    [(Key, Value)] -> Value
object ([(Key, Value)] -> Value) -> [(Key, Value)] -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"op" Key -> Op -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Op
op') (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: Key -> Maybe Path -> [(Key, Value)]
forall {a} {v}. (KeyValue a, ToJSON v) => Key -> Maybe v -> [a]
optionalField Key
"path" Maybe Path
path' [(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. [a] -> [a] -> [a]
++ Key -> Maybe Value -> [(Key, Value)]
forall {a} {v}. (KeyValue a, ToJSON v) => Key -> Maybe v -> [a]
optionalField Key
"value" Maybe Value
value'
    where
      optionalField :: Key -> Maybe v -> [a]
optionalField Key
fname = \case
        Maybe v
Nothing -> []
        Just v
x -> [Key
fname Key -> v -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> a
.= v
x]

instance FromJSON Op where
  parseJSON :: Value -> Parser Op
parseJSON = String -> (Text -> Parser Op) -> Value -> Parser Op
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Op" ((Text -> Parser Op) -> Value -> Parser Op)
-> (Text -> Parser Op) -> Value -> Parser Op
forall a b. (a -> b) -> a -> b
$ \Text
op' ->
    case Text -> Text
forall s. FoldCase s => s -> s
CI.foldCase Text
op' of
      Text
"add" -> Op -> Parser Op
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
Add
      Text
"replace" -> Op -> Parser Op
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
Replace
      Text
"remove" -> Op -> Parser Op
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Op
Remove
      Text
_ -> String -> Parser Op
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown operation"

instance ToJSON Op where
  toJSON :: Op -> Value
toJSON Op
Add = Text -> Value
String Text
"add"
  toJSON Op
Replace = Text -> Value
String Text
"replace"
  toJSON Op
Remove = Text -> Value
String Text
"remove"

instance ToJSON Path where
  toJSON :: Path -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Path -> Text) -> Path -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Text
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 :: forall (m :: * -> *).
MonadError ScimError m =>
KeyMap Text -> Operation -> m (KeyMap Text)
applyOperation KeyMap Text
theMap (Operation Op
Remove (Just (NormalPath (AttrPath Maybe Schema
_schema (AttrName Text
attrName) Maybe SubAttr
_subAttr))) Maybe Value
_) =
    KeyMap Text -> m (KeyMap Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap Text -> m (KeyMap Text)) -> KeyMap Text -> m (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ Key -> KeyMap Text -> KeyMap Text
forall v. Key -> KeyMap v -> KeyMap v
KeyMap.delete (Text -> Key
Key.fromText Text
attrName) KeyMap Text
theMap
  applyOperation KeyMap Text
theMap (Operation Op
_AddOrReplace (Just (NormalPath (AttrPath Maybe Schema
_schema (AttrName Text
attrName) Maybe SubAttr
_subAttr))) (Just (String Text
val))) =
    KeyMap Text -> m (KeyMap Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KeyMap Text -> m (KeyMap Text)) -> KeyMap Text -> m (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ Key -> Text -> KeyMap Text -> KeyMap Text
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (Text -> Key
Key.fromText Text
attrName) Text
val KeyMap Text
theMap
  applyOperation KeyMap Text
_ Operation
_ = ScimError -> m (KeyMap Text)
forall a. ScimError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ScimError -> m (KeyMap Text)) -> ScimError -> m (KeyMap Text)
forall a b. (a -> b) -> a -> b
$ ScimErrorType -> Maybe Text -> ScimError
badRequest ScimErrorType
InvalidValue (Maybe Text -> ScimError) -> Maybe Text -> ScimError
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Unsupported operation"