Move allowScim argument to update structure

libs/wire-subsystems/src/Wire/MiniBackend.hs

@@ -352,7 +352,7 @@ staticUserStoreInterpreter = interpret $ \case
             maybe Imports.id setStoredUserAccentId update.accentId
               . maybe Imports.id setStoredUserAssets update.assets
               . maybe Imports.id setStoredUserPict update.pict
-              . maybe Imports.id setStoredUserName update.name
+              . maybe Imports.id (setStoredUserName . (.value)) update.name
               $ u
       doUpdate u = u
 

libs/wire-subsystems/src/Wire/UserStore.hs

@@ -10,10 +10,33 @@ import Wire.API.User
 import Wire.Arbitrary
 import Wire.StoredUser
 
+data AllowSCIMUpdates
+  = AllowSCIMUpdates
+  | ForbidSCIMUpdates
+  deriving (Show, Eq, Ord, Generic)
+  deriving (Arbitrary) via GenericUniform AllowSCIMUpdates
+
+data ScimUpdate a = MkScimUpdate
+  { -- | whether changes to SCIM-managed users should be allowed
+    allowScim :: AllowSCIMUpdates,
+    value :: a
+  }
+  deriving stock (Eq, Ord, Show)
+  deriving (Functor, Foldable, Traversable)
+
+forbidScimUpdate :: a -> ScimUpdate a
+forbidScimUpdate = MkScimUpdate ForbidSCIMUpdates
+
+allowScimUpdate :: a -> ScimUpdate a
+allowScimUpdate = MkScimUpdate AllowSCIMUpdates
+
+instance Arbitrary a => Arbitrary (ScimUpdate a) where
+  arbitrary = MkScimUpdate <$> arbitrary <*> arbitrary
+
 -- this is similar to `UserUpdate` in `Wire.API.User`, but supports updates to
 -- all profile fields rather than just four.
 data UserProfileUpdate = MkUserProfileUpdate
-  { name :: Maybe Name,
+  { name :: Maybe (ScimUpdate Name),
     pict :: Maybe Pict,
     assets :: Maybe [Asset],
     accentId :: Maybe ColourId,

libs/wire-subsystems/src/Wire/UserStore/Cassandra.hs

@@ -26,7 +26,7 @@ updateUserImpl :: Member (Embed Client) r => UserId -> UserProfileUpdate -> Sem
 updateUserImpl uid update = embed . retry x5 . batch $ do
   setType BatchLogged
   setConsistency LocalQuorum
-  for_ update.name $ \n -> addPrepQuery userDisplayNameUpdate (n, uid)
+  for_ update.name $ \n -> addPrepQuery userDisplayNameUpdate (n.value, uid)
   for_ update.pict $ \p -> addPrepQuery userPictUpdate (p, uid)
   for_ update.assets $ \a -> addPrepQuery userAssetsUpdate (a, uid)
   for_ update.accentId $ \c -> addPrepQuery userAccentIdUpdate (c, uid)

libs/wire-subsystems/src/Wire/UserSubsystem.hs

@@ -13,7 +13,6 @@ import Wire.API.Error
 import Wire.API.Error.Brig (BrigError (..))
 import Wire.API.Federation.Error
 import Wire.API.User
-import Wire.Arbitrary
 import Wire.UserStore
 
 -- | All errors that are thrown by the user subsystem are subsumed under this sum type.
@@ -32,12 +31,6 @@ userSubsystemErrorToWai =
 
 instance Exception UserSubsystemError
 
-data AllowSCIMUpdates
-  = AllowSCIMUpdates
-  | ForbidSCIMUpdates
-  deriving (Show, Eq, Ord, Generic)
-  deriving (Arbitrary) via GenericUniform AllowSCIMUpdates
-
 data UserSubsystem m a where
   -- | First arg is for authorization only.
   GetUserProfiles :: Local UserId -> [Qualified UserId] -> UserSubsystem m [UserProfile]
@@ -46,7 +39,7 @@ data UserSubsystem m a where
   -- | These give us partial success and hide concurrency in the interpreter.
   -- FUTUREWORK: it would be better to return errors as `Map Domain FederationError`, but would clients like that?
   GetUserProfilesWithErrors :: Local UserId -> [Qualified UserId] -> UserSubsystem m ([(Qualified UserId, FederationError)], [UserProfile])
-  UpdateUserProfile :: Local UserId -> Maybe ConnId -> UserProfileUpdate -> AllowSCIMUpdates -> UserSubsystem m ()
+  UpdateUserProfile :: Local UserId -> Maybe ConnId -> UserProfileUpdate -> UserSubsystem m ()
 
 makeSem ''UserSubsystem
 

libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs

@@ -34,7 +34,7 @@ import Wire.Sem.Now qualified as Now
 import Wire.StoredUser
 import Wire.UserEvents
 import Wire.UserStore
-import Wire.UserSubsystem (AllowSCIMUpdates (..), UserSubsystem (..), UserSubsystemError (..))
+import Wire.UserSubsystem
 
 data UserSubsystemConfig = UserSubsystemConfig
   { emailVisibilityConfig :: EmailVisibilityConfig,
@@ -83,7 +83,7 @@ interpretUserSubsystem = interpret $ \case
   GetUserProfiles self others -> getUserProfilesImpl self others
   GetLocalUserProfiles others -> getLocalUserProfilesImpl others
   GetUserProfilesWithErrors self others -> getUserProfilesWithErrorsImpl self others
-  UpdateUserProfile self mconn update allowScim -> updateUserProfileImpl self mconn update allowScim
+  UpdateUserProfile self mconn update -> updateUserProfileImpl self mconn update
 
 -- | Obtain user profiles for a list of users as they can be seen by
 -- a given user 'self'. If 'self' is an unknown 'UserId', return '[]'.
@@ -179,7 +179,7 @@ getUserProfilesLocalPart requestingUser luids = do
           <$> traverse getRequestingUserInfo requestingUser
   -- FUTUREWORK: (in the interpreters where it makes sense) pull paginated lists from the DB,
   -- not just single rows.
-  catMaybes <$> traverse (getLocalUserProfile emailVisibilityConfigWithViewer) (sequence luids)
+  catMaybes <$> traverse (getLocalUserProfileImpl emailVisibilityConfigWithViewer) (sequence luids)
   where
     getRequestingUserInfo :: Local UserId -> Sem r (Maybe (TeamId, TeamMember))
     getRequestingUserInfo self = do
@@ -195,7 +195,7 @@ getUserProfilesLocalPart requestingUser luids = do
         Nothing -> pure Nothing
         Just tid -> (tid,) <$$> getTeamMember (tUnqualified self) tid
 
-getLocalUserProfile ::
+getLocalUserProfileImpl ::
   forall r.
   ( Member UserStore r,
     Member GalleyAPIAccess r,
@@ -206,7 +206,7 @@ getLocalUserProfile ::
   EmailVisibilityConfigWithViewer ->
   Local UserId ->
   Sem r (Maybe UserProfile)
-getLocalUserProfile emailVisibilityConfigWithViewer luid = do
+getLocalUserProfileImpl emailVisibilityConfigWithViewer luid = do
   let domain = tDomain luid
   locale <- inputs defaultLocale
   runMaybeT $ do
@@ -278,24 +278,23 @@ updateUserProfileImpl ::
   Local UserId ->
   Maybe ConnId ->
   UserProfileUpdate ->
-  AllowSCIMUpdates ->
   Sem r ()
-updateUserProfileImpl (tUnqualified -> uid) mconn update allowScim = do
+updateUserProfileImpl (tUnqualified -> uid) mconn update = do
   -- check if name updates are allowed
-  for_ update.name $ \newName -> do
+  for_ update.name $ \nameUpdate -> do
     mbUser <- getUser uid
     user <- maybe (throw UserSubsystemProfileNotFound) pure mbUser
     unless
       ( user.managedBy /= Just ManagedByScim
-          || user.name == newName
-          || allowScim == AllowSCIMUpdates
+          || user.name == nameUpdate.value
+          || AllowSCIMUpdates == nameUpdate.allowScim
       )
       $ throw UserSubsystemDisplayNameManagedByScim
     hasE2EId <-
       wsStatus . afcMlsE2EId <$> getAllFeatureConfigsForUser (Just uid) <&> \case
         FeatureStatusEnabled -> True
         FeatureStatusDisabled -> False
-    when (hasE2EId && newName /= user.name) $
+    when (hasE2EId && nameUpdate.value /= user.name) $
       throw UserSubsystemDisplayNameManagedByScim
 
   updateUser uid update
@@ -305,7 +304,7 @@ mkProfileUpdateEvent :: UserId -> UserProfileUpdate -> UserEvent
 mkProfileUpdateEvent uid update =
   UserUpdated $
     (emptyUserUpdatedData uid)
-      { eupName = update.name,
+      { eupName = fmap (.value) update.name,
         eupPict = update.pict,
         eupAccentId = update.accentId,
         eupAssets = update.assets

libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs

@@ -200,34 +200,29 @@ spec = describe "UserSubsystem.Interpreter" do
             .&&. length (snd retrievedProfilesWithErrors) === length remoteAUsers
 
     prop "Update user" $
-      \(NotPendingStoredUser alice) localDomain update config allowScim -> do
+      \(NotPendingStoredUser alice) localDomain update config -> do
         let lusr = toLocalUnsafe localDomain alice.id
             localBackend = def {users = [alice {managedBy = Just ManagedByWire}]}
             profile = fromJust $ runNoFederationStack localBackend Nothing config do
               updateUserProfile
                 lusr
                 Nothing
                 update
-                allowScim
               getUserProfile lusr (tUntagged lusr)
          in profile.profileQualifiedId === tUntagged lusr
               -- if the name/ pict/ assets/ accent id are not set, the original
               -- value should be preserved
-              .&&. profile.profileName === fromMaybe profile.profileName update.name
+              .&&. profile.profileName === maybe profile.profileName (.value) update.name
               .&&. profile.profilePict === fromMaybe profile.profilePict update.pict
               .&&. profile.profileAssets === fromMaybe profile.profileAssets update.assets
               .&&. profile.profileAccentId === fromMaybe profile.profileAccentId update.accentId
 
     prop "Update user events" $
-      \(NotPendingStoredUser alice) localDomain update config allowScim -> do
+      \(NotPendingStoredUser alice) localDomain update config -> do
         let lusr = toLocalUnsafe localDomain alice.id
             localBackend = def {users = [alice {managedBy = Just ManagedByWire}]}
             events = runNoFederationStack localBackend Nothing config do
-              updateUserProfile
-                lusr
-                Nothing
-                update
-                allowScim
+              updateUserProfile lusr Nothing update
               get @[MiniEvent]
          in events === [MkMiniEvent alice.id (mkProfileUpdateEvent alice.id update)]
 
@@ -242,7 +237,7 @@ spec = describe "UserSubsystem.Interpreter" do
                   . runErrorUnsafe
                   . runError
                   $ interpretNoFederationStack localBackend Nothing def config do
-                    updateUserProfile lusr Nothing update {name = Just name} ForbidSCIMUpdates
+                    updateUserProfile lusr Nothing update {name = Just (forbidScimUpdate name)}
                     getUserProfile lusr (tUntagged lusr)
            in Left UserSubsystemDisplayNameManagedByScim === profileErr
 
@@ -257,6 +252,6 @@ spec = describe "UserSubsystem.Interpreter" do
                   . runErrorUnsafe
                   . runError
                   $ interpretNoFederationStack localBackend Nothing def {afcMlsE2EId = setStatus FeatureStatusEnabled defFeatureStatus} config do
-                    updateUserProfile lusr Nothing update {name = Just name} AllowSCIMUpdates
+                    updateUserProfile lusr Nothing update {name = Just (allowScimUpdate name)}
                     getUserProfile lusr (tUntagged lusr)
            in Left UserSubsystemDisplayNameManagedByScim === profileErr

services/brig/brig.cabal

@@ -264,8 +264,8 @@ library
     , cql
     , cryptobox-haskell          >=0.1.1
     , currency-codes             >=2.0
-    , data-timeout               >=0.3
     , data-default
+    , data-timeout               >=0.3
     , dns
     , dns-util
     , enclosed-exceptions        >=1.0

services/brig/src/Brig/API/Internal.hs

@@ -105,7 +105,7 @@ import Wire.NotificationSubsystem
 import Wire.Rpc
 import Wire.Sem.Concurrency
 import Wire.Sem.Paging.Cassandra (InternalPaging)
-import Wire.UserStore (UserProfileUpdate (..))
+import Wire.UserStore (UserProfileUpdate (..), allowScimUpdate)
 import Wire.UserSubsystem
 
 servantSitemap ::
@@ -869,9 +869,9 @@ updateUserNameH uid (NameUpdate nameUpd) =
   NoContent <$ do
     luid <- qualifyLocal uid
     name <- either (const $ throwStd (errorToWai @'E.InvalidUser)) pure $ mkName nameUpd
-    let uu = (def :: UserProfileUpdate) {name = Just name}
+    let uu = (def :: UserProfileUpdate) {name = Just (allowScimUpdate name)}
     lift (wrapClient $ Data.lookupUser WithPendingInvitations uid) >>= \case
-      Just _ -> lift . liftSem $ updateUserProfile luid Nothing uu API.AllowSCIMUpdates
+      Just _ -> lift . liftSem $ updateUserProfile luid Nothing uu
       Nothing -> throwStd (errorToWai @'E.InvalidUser)
 
 checkHandleInternalH :: Handle -> (Handler r) CheckHandleResponse

services/brig/src/Brig/API/Public.hs

@@ -165,7 +165,7 @@ import Wire.Sem.Concurrency
 import Wire.Sem.Jwk (Jwk)
 import Wire.Sem.Now (Now)
 import Wire.Sem.Paging.Cassandra (InternalPaging)
-import Wire.UserStore (UserProfileUpdate (..))
+import Wire.UserStore (UserProfileUpdate (..), forbidScimUpdate)
 import Wire.UserSubsystem
 
 -- User API -----------------------------------------------------------
@@ -927,13 +927,13 @@ updateUser ::
 updateUser uid conn uu = do
   let update =
         def
-          { name = uu.uupName,
+          { name = fmap forbidScimUpdate uu.uupName,
             pict = uu.uupPict,
             assets = uu.uupAssets,
             accentId = uu.uupAccentId
           }
   lift . liftSem $
-    updateUserProfile uid (Just conn) update ForbidSCIMUpdates
+    updateUserProfile uid (Just conn) update
 
 changePhone ::
   ( Member BlacklistStore r,
@@ -995,7 +995,6 @@ changeLocale lusr conn l =
       lusr
       (Just conn)
       def {locale = Just l.luLocale}
-      ForbidSCIMUpdates
 
 changeSupportedProtocols ::
   ( Member (Embed HttpClientIO) r,

services/brig/src/Brig/API/User.hs

@@ -181,6 +181,7 @@ import Wire.NotificationSubsystem
 import Wire.Sem.Concurrency
 import Wire.Sem.Paging.Cassandra (InternalPaging)
 import Wire.UserSubsystem
+import Wire.UserStore (AllowSCIMUpdates(..))
 
 -------------------------------------------------------------------------------
 -- Create User