Keep track of who is allowed to modify users (we vs. SCIM)

libs/api-bot/src/Network/Wire/Bot/Cache.hs

@@ -74,6 +74,7 @@ toUser _ acc [i, e, p] = do
         , userHandle   = Nothing
         , userExpire   = Nothing
         , userTeam     = Nothing
+        , userManagedBy = ManagedByWire
         }
 toUser g acc entry = do
     warn g $ msg (val "invalid entry: " +++ show entry)

libs/api-bot/src/Network/Wire/Bot/Monad.hs

@@ -887,6 +887,7 @@ randUser (Email loc dom) (BotTag tag) = do
         , newUserLabel          = Nothing
         , newUserLocale         = Nothing
         , newUserExpiresIn      = Nothing
+        , newUserManagedBy      = Nothing
         }, passw)
 
 randMailbox :: BotNet Mailbox

libs/brig-types/src/Brig/Types/Common.hs

@@ -386,3 +386,44 @@ codeParser :: String -> (String -> Maybe a) -> Parser a
 codeParser err conv = do
     code <- count 2 anyChar
     maybe (fail err) return (conv code)
+
+-----------------------------------------------------------------------------
+-- ManagedBy
+
+-- | Who controls changes to the user profile (where the profile is defined as "all
+-- user-editable, user-visible attributes").
+data ManagedBy
+      -- | The profile can be changed in-app; user doesn't show up via SCIM at all.
+    = ManagedByWire
+      -- | The profile can only be changed via SCIM, with several exceptions:
+      --
+      --   1. User properties can still be set (because they are used internally by clients
+      --      and none of them can be modified via SCIM now or in the future).
+      --
+      --   2. Password can be changed by the user (SCIM doesn't support setting passwords yet,
+      --      but currently SCIM only works with SSO-users who don't even have passwords).
+      --
+      --   3. The user can still be deleted normally (SCIM doesn't support deleting users yet;
+      --      but it's questionable whether this should even count as a /change/ of a user
+      --      profile).
+      --
+      -- There are some other things that SCIM can't do yet, like setting accent IDs, but they
+      -- are not essential, unlike e.g. passwords.
+    | ManagedByScim
+    deriving (Eq, Show, Bounded, Enum)
+
+instance FromJSON ManagedBy where
+    parseJSON = withText "ManagedBy" $ \case
+        "wire" -> pure ManagedByWire
+        "scim" -> pure ManagedByScim
+        other  -> fail $ "Invalid ManagedBy: " ++ show other
+
+instance ToJSON ManagedBy where
+    toJSON = String . \case
+        ManagedByWire -> "wire"
+        ManagedByScim -> "scim"
+
+defaultManagedBy :: ManagedBy
+defaultManagedBy = ManagedByWire
+
+-- NB: when adding new types, please add a roundtrip test to "Test.Brig.Types.Common"

libs/brig-types/src/Brig/Types/Swagger.hs

@@ -127,6 +127,10 @@ self = defineModel "Self" $ do
     property "deleted" bool' $ do
         description "Whether the account has been deleted."
         optional
+    property "managed_by" managedBy $ do
+        description "What is the source of truth for this user; if it's SCIM \
+                    \then the profile can't be edited via normal means"
+        optional
 
 user :: Model
 user = defineModel "User" $ do
@@ -150,6 +154,12 @@ user = defineModel "User" $ do
         description "Unique user handle."
         optional
 
+managedBy :: DataType
+managedBy = string $ enum
+    [ "wire"
+    , "scim"
+    ]
+
 assetType :: DataType
 assetType = string $ enum
     [ "image"

libs/brig-types/src/Brig/Types/User.hs

@@ -127,6 +127,9 @@ data User = User
         -- ^ Set if the user is ephemeral
     , userTeam     :: !(Maybe TeamId)
         -- ^ Set if the user is part of a binding team
+    , userManagedBy :: !ManagedBy
+        -- ^ How is the user profile managed (e.g. if it's via SCIM then the user profile
+        -- can't be edited via normal means)
     }
     deriving (Eq, Show)
 
@@ -139,8 +142,9 @@ userPhone = phoneIdentity <=< userIdentity
 userSSOId :: User -> Maybe UserSSOId
 userSSOId = ssoIdentity <=< userIdentity
 
--- | A subset of the data of an existing 'User'
--- that is returned on the API.
+-- | A subset of the data of an existing 'User' that is returned on the API and is visible to
+-- other users. Each user also has access to their own profile in a richer format --
+-- 'SelfProfile'.
 data UserProfile = UserProfile
     { profileId       :: !UserId
     , profileName     :: !Name
@@ -170,11 +174,12 @@ instance ToJSON User where
         # "accent_id"  .= userAccentId u
         # "deleted"    .= (if userDeleted u then Just True else Nothing)
         # "locale"     .= userLocale u
-        # "service"    .= userService u
-        # "handle"     .= userHandle u
+        # "service"    .= userService u
+        # "handle"     .= userHandle u
         # "expires_at" .= userExpire u
         # "team"       .= userTeam u
         # "sso_id"     .= userSSOId u
+        # "managed_by" .= userManagedBy u
         # []
 
 instance FromJSON User where
@@ -192,6 +197,7 @@ instance FromJSON User where
              <*> o .:? "handle"
              <*> o .:? "expires_at"
              <*> o .:? "team"
+             <*> o .:? "managed_by" .!= ManagedByWire
 
 instance FromJSON UserProfile where
     parseJSON = withObject "UserProfile" $ \o ->
@@ -215,8 +221,8 @@ instance ToJSON UserProfile where
         # "assets"     .= profileAssets u
         # "accent_id"  .= profileAccentId u
         # "deleted"    .= (if profileDeleted u then Just True else Nothing)
-        # "service"    .= profileService u
-        # "handle"     .= profileHandle u
+        # "service"    .= profileService u
+        # "handle"     .= profileHandle u
         # "locale"     .= profileLocale u
         # "expires_at" .= profileExpire u
         # "team"       .= profileTeam u
@@ -246,6 +252,7 @@ data NewUser = NewUser
     , newUserLocale         :: !(Maybe Locale)
     , newUserPassword       :: !(Maybe PlainTextPassword)
     , newUserExpiresIn      :: !(Maybe ExpiresIn)
+    , newUserManagedBy      :: !(Maybe ManagedBy)
     }
     deriving (Eq, Show)
 
@@ -322,6 +329,7 @@ instance FromJSON NewUser where
           newUserExpiresIn <- case (newUserExpires, newUserIdentity) of
                 (Just _, Just _) -> fail "Only users without an identity can expire"
                 _                -> return newUserExpires
+          newUserManagedBy <- o .:? "managed_by"
           return NewUser{..}
 
 instance ToJSON NewUser where
@@ -341,6 +349,7 @@ instance ToJSON NewUser where
         # "password"        .= newUserPassword u
         # "expires_in"      .= newUserExpiresIn u
         # "sso_id"          .= newUserSSOId u
+        # "managed_by"      .= newUserManagedBy u
         # maybe [] jsonNewUserOrigin (newUserOrigin u)
 
 -- | Fails if email or phone or ssoid are present but invalid
@@ -379,19 +388,32 @@ data NewTeamUser = NewTeamMember    !InvitationCode      -- ^ requires email add
                  | NewTeamMemberSSO !TeamId
     deriving (Eq, Show)
 
--- | newtype for using in external end-points where setting 'SSOIdentity', 'UUID' is not allowed.
--- ('UUID' is only needed by spar for creating users that it can find again later, after a crash.
--- if there another use case arises, this newtype and the 'FromJSON' instance would have to be
--- refactored.)
-newtype NewUserNoSSO = NewUserNoSSO NewUser
+-- | We use the same 'NewUser' type for the @\/register@ and @\/i\/users@ endpoints. This
+-- newtype is used as request body type for the public @\/register@ endpoint, where only a
+-- subset of the 'NewUser' functionality should be allowed.
+--
+-- Specifically, we forbid the following:
+--
+--   * Setting 'SSOIdentity' (SSO users are created by Spar)
+--
+--   * Setting the UUID (only needed so that Spar can find the user if Spar crashes before it
+--     finishes creating the user).
+--
+--   * Setting 'ManagedBy' (it should be the default in all cases unless Spar creates a
+--     SCIM-managed user)
+newtype NewUserPublic = NewUserPublic NewUser
     deriving (Eq, Show)
 
-instance FromJSON NewUserNoSSO where
+instance FromJSON NewUserPublic where
     parseJSON val = do
         nu <- parseJSON val
-        when (isJust $ newUserSSOId nu) $ fail "SSO-managed users are not allowed here."
-        when (isJust $ newUserUUID nu)  $ fail "it is not allowed to provide a UUID for the users here."
-        pure $ NewUserNoSSO nu
+        when (isJust $ newUserSSOId nu) $
+            fail "SSO-managed users are not allowed here."
+        when (isJust $ newUserUUID nu) $
+            fail "it is not allowed to provide a UUID for the users here."
+        when (newUserManagedBy nu `notElem` [Nothing, Just ManagedByWire]) $
+            fail "only managed-by-Wire users can be created here."
+        pure $ NewUserPublic nu
 
 
 -----------------------------------------------------------------------------
@@ -405,12 +427,16 @@ data UserUpdate = UserUpdate
     } deriving (Eq, Show)
 
 newtype LocaleUpdate = LocaleUpdate { luLocale :: Locale } deriving (Eq, Show)
+newtype EmailUpdate = EmailUpdate { euEmail :: Email } deriving (Eq, Show)
+newtype PhoneUpdate = PhoneUpdate { puPhone :: Phone } deriving (Eq, Show)
+newtype HandleUpdate = HandleUpdate { huHandle :: Text } deriving (Eq, Show)
+newtype ManagedByUpdate = ManagedByUpdate { mbuManagedBy :: ManagedBy } deriving (Eq, Show)
 
-newtype EmailUpdate  = EmailUpdate  { euEmail  :: Email  } deriving (Eq, Show)
-newtype PhoneUpdate  = PhoneUpdate  { puPhone  :: Phone  } deriving (Eq, Show)
-newtype HandleUpdate = HandleUpdate { huHandle :: Text   } deriving (Eq, Show)
-newtype EmailRemove  = EmailRemove  { erEmail  :: Email  } deriving (Eq, Show)
-newtype PhoneRemove  = PhoneRemove  { prPhone  :: Phone  } deriving (Eq, Show)
+newtype EmailRemove = EmailRemove { erEmail :: Email } deriving (Eq, Show)
+newtype PhoneRemove = PhoneRemove { prPhone :: Phone } deriving (Eq, Show)
+
+-- NB: when adding new types, please also add roundtrip tests to
+-- 'Test.Brig.Types.User.roundtripTests'
 
 instance FromJSON UserUpdate where
     parseJSON = withObject "UserUpdate" $ \o ->
@@ -455,6 +481,13 @@ instance FromJSON HandleUpdate where
 instance ToJSON HandleUpdate where
     toJSON h = object ["handle" .= huHandle h]
 
+instance FromJSON ManagedByUpdate where
+    parseJSON = withObject "managed-by-update" $ \o ->
+        ManagedByUpdate <$> o .: "managed_by"
+
+instance ToJSON ManagedByUpdate where
+    toJSON m = object ["managed_by" .= mbuManagedBy m]
+
 instance FromJSON EmailRemove where
     parseJSON = withObject "email-remove" $ \o ->
         EmailRemove <$> o .: "email"

libs/brig-types/test/unit/Test/Brig/Types/Arbitrary.hs

@@ -206,6 +206,9 @@ instance Arbitrary HandleUpdate where
 instance Arbitrary LocaleUpdate where
     arbitrary = LocaleUpdate <$> arbitrary
 
+instance Arbitrary ManagedByUpdate where
+    arbitrary = ManagedByUpdate <$> arbitrary
+
 instance Arbitrary NewPasswordReset where
     arbitrary = NewPasswordReset <$> arbitrary
 
@@ -234,6 +237,7 @@ instance Arbitrary NewUser where
         newUserLocale     <- arbitrary
         newUserPassword   <- if isTeamUser && not hasSSOId then Just <$> arbitrary else arbitrary
         newUserExpiresIn  <- if isJust newUserIdentity then pure Nothing else arbitrary
+        newUserManagedBy  <- arbitrary
         pure NewUser{..}
 
 instance Arbitrary UTCTimeMillis where
@@ -323,6 +327,7 @@ instance Arbitrary User where
         <*> arbitrary
         <*> arbitrary
         <*> arbitrary
+        <*> arbitrary
 
 instance Arbitrary VerifyDeleteUser where
     arbitrary = VerifyDeleteUser <$> arbitrary <*> arbitrary
@@ -369,6 +374,9 @@ instance Arbitrary InvitationRequest where
 instance Arbitrary Role where
     arbitrary = elements [minBound..]
 
+instance Arbitrary ManagedBy where
+    arbitrary = elements [minBound..]
+
 ----------------------------------------------------------------------
 -- utilities
 

libs/brig-types/test/unit/Test/Brig/Types/Common.hs

@@ -29,6 +29,7 @@ tests = testGroup "Common (types vs. aeson)"
     , run @AssetSize Proxy
     , run @Asset Proxy
     , run @ExcludedPrefix Proxy
+    , run @ManagedBy Proxy
     ]
   where
     run :: forall a. (Arbitrary a, Typeable a, ToJSON a, FromJSON a, Eq a, Show a)

libs/brig-types/test/unit/Test/Brig/Types/User.hs

@@ -87,6 +87,7 @@ roundtripTests =
     , run @PasswordChange Proxy
     , run @PhoneRemove Proxy
     , run @PhoneUpdate Proxy
+    , run @ManagedByUpdate Proxy
     , run @ReAuthUser Proxy
     , run @SelfProfile Proxy
     , run @TeamMember Proxy

services/brig/brig.cabal

@@ -294,6 +294,7 @@ executable brig-schema
         V54
         V55
         V56
+        V57
 
     build-depends:
         base

services/brig/schema/src/Main.hs

@@ -53,6 +53,7 @@ import qualified V53
 import qualified V54
 import qualified V55
 import qualified V56
+import qualified V57
 
 main :: IO ()
 main = do
@@ -106,4 +107,5 @@ main = do
         , V54.migration
         , V55.migration
         , V56.migration
+        , V57.migration
         ] `finally` close l

services/brig/schema/src/V56.hs

@@ -23,4 +23,3 @@ migration = Migration 56 "Add table to exclude phone number prefixes" $ do
             , primary key (prefix)
             )
     |]
-

services/brig/schema/src/V57.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+
+module V57 (migration) where
+
+import Imports
+import Cassandra.Schema
+import Text.RawString.QQ
+
+migration :: Migration
+migration = Migration 57 "Add managed_by" $ do
+    schema' [r| alter table user add managed_by int; |]

services/brig/src/Brig/API.hs

@@ -19,7 +19,7 @@ import Brig.API.Types
 import Brig.Options hiding (sesQueue, internalEvents)
 import Brig.Types
 import Brig.Types.Intra
-import Brig.Types.User (NewUserNoSSO(NewUserNoSSO))
+import Brig.Types.User (NewUserPublic(NewUserPublic))
 import Brig.Types.User.Auth
 import Brig.User.Email
 import Brig.User.Phone
@@ -219,6 +219,12 @@ sitemap o = do
       .&. contentType "application" "json"
       .&. request
 
+    put "/i/users/:uid/managed-by" (continue updateManagedBy) $
+      capture "uid"
+      .&. accept "application" "json"
+      .&. contentType "application" "json"
+      .&. request
+
     post "/i/clients" (continue internalListClients) $
       accept "application" "json"
       .&. contentType "application" "json"
@@ -474,7 +480,7 @@ sitemap o = do
         header "Z-User"
 
     document "HEAD" "checkPassword" $ do
-        Doc.summary "Check that your passowrd is set"
+        Doc.summary "Check that your password is set"
         Doc.response 200 "Password is set." Doc.end
         Doc.response 404 "Password is not set." Doc.end
 
@@ -1098,7 +1104,7 @@ autoConnect(_ ::: _ ::: uid ::: conn ::: req) = do
 
 createUser :: JSON ::: JSON ::: Request -> Handler Response
 createUser (_ ::: _ ::: req) = do
-    NewUserNoSSO new <- parseJsonBody req
+    NewUserPublic new <- parseJsonBody req
     for_ (newUserEmail new) $ checkWhitelist . Left
     for_ (newUserPhone new) $ checkWhitelist . Right
     result <- API.createUser new !>> newUserError
@@ -1464,6 +1470,12 @@ updateSSOId (uid ::: _ ::: _ ::: req) = do
       then return empty
       else return . setStatus status404 $ plain "User does not exist or has no team."
 
+updateManagedBy :: UserId ::: JSON ::: JSON ::: Request -> Handler Response
+updateManagedBy (uid ::: _ ::: _ ::: req) = do
+    ManagedByUpdate managedBy <- parseJsonBody req
+    lift $ Data.updateManagedBy uid managedBy
+    return empty
+
 deleteUser :: UserId ::: Request ::: JSON ::: JSON -> Handler Response
 deleteUser (u ::: r ::: _ ::: _) = do
     body <- parseJsonBody r