Skip to content

Commit

Permalink
Keep track of who is allowed to modify users (we vs. SCIM) (#602)
Browse files Browse the repository at this point in the history
  • Loading branch information
Artyom Kazak authored Feb 6, 2019
1 parent 7735fae commit 11dfe00
Show file tree
Hide file tree
Showing 24 changed files with 258 additions and 86 deletions.
1 change: 1 addition & 0 deletions libs/api-bot/src/Network/Wire/Bot/Cache.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
1 change: 1 addition & 0 deletions libs/api-bot/src/Network/Wire/Bot/Monad.hs
Original file line number Diff line number Diff line change
Expand Up @@ -887,6 +887,7 @@ randUser (Email loc dom) (BotTag tag) = do
, newUserLabel = Nothing
, newUserLocale = Nothing
, newUserExpiresIn = Nothing
, newUserManagedBy = Nothing
}, passw)

randMailbox :: BotNet Mailbox
Expand Down
41 changes: 41 additions & 0 deletions libs/brig-types/src/Brig/Types/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
10 changes: 10 additions & 0 deletions libs/brig-types/src/Brig/Types/Swagger.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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"
Expand Down
73 changes: 53 additions & 20 deletions libs/brig-types/src/Brig/Types/User.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 ->
Expand All @@ -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
Expand Down Expand Up @@ -246,6 +252,7 @@ data NewUser = NewUser
, newUserLocale :: !(Maybe Locale)
, newUserPassword :: !(Maybe PlainTextPassword)
, newUserExpiresIn :: !(Maybe ExpiresIn)
, newUserManagedBy :: !(Maybe ManagedBy)
}
deriving (Eq, Show)

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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


-----------------------------------------------------------------------------
Expand All @@ -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 ->
Expand Down Expand Up @@ -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"
Expand Down
8 changes: 8 additions & 0 deletions libs/brig-types/test/unit/Test/Brig/Types/Arbitrary.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -323,6 +327,7 @@ instance Arbitrary User where
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary

instance Arbitrary VerifyDeleteUser where
arbitrary = VerifyDeleteUser <$> arbitrary <*> arbitrary
Expand Down Expand Up @@ -369,6 +374,9 @@ instance Arbitrary InvitationRequest where
instance Arbitrary Role where
arbitrary = elements [minBound..]

instance Arbitrary ManagedBy where
arbitrary = elements [minBound..]

----------------------------------------------------------------------
-- utilities

Expand Down
1 change: 1 addition & 0 deletions libs/brig-types/test/unit/Test/Brig/Types/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
1 change: 1 addition & 0 deletions libs/brig-types/test/unit/Test/Brig/Types/User.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions services/brig/brig.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -294,6 +294,7 @@ executable brig-schema
V54
V55
V56
V57

build-depends:
base
Expand Down
2 changes: 2 additions & 0 deletions services/brig/schema/src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,7 @@ import qualified V53
import qualified V54
import qualified V55
import qualified V56
import qualified V57

main :: IO ()
main = do
Expand Down Expand Up @@ -106,4 +107,5 @@ main = do
, V54.migration
, V55.migration
, V56.migration
, V57.migration
] `finally` close l
1 change: 0 additions & 1 deletion services/brig/schema/src/V56.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,4 +23,3 @@ migration = Migration 56 "Add table to exclude phone number prefixes" $ do
, primary key (prefix)
)
|]

12 changes: 12 additions & 0 deletions services/brig/schema/src/V57.hs
Original file line number Diff line number Diff line change
@@ -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; |]
18 changes: 15 additions & 3 deletions services/brig/src/Brig/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 11dfe00

Please sign in to comment.