diff --git a/CHANGELOG.md b/CHANGELOG.md index c13e45b639d..aa3f96ea2c5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,24 @@ --> +# [2021-01-12] + +## Release Notes + +This release contains bugfixes and internal changes. + +## Bug fixes and other updates + +* [SCIM] Fix bug: Deleting a user retains their externalId (#1323) +* [SCIM] Fix bug: Provisioned users can update update to email, handle, name (#1320) + +## Internal changes + +* [SCIM] Add logging to SCIM ops, invitation ops, createUser (#1322) (#1318) +* Upgrade nixpkgs and add HLS to shell.nix (#1314) +* create_test_team_scim.sh script: fix arg parsing and invite (#1321) + + # [2021-01-06] ## Release Notes diff --git a/deploy/services-demo/create_test_team_scim.sh b/deploy/services-demo/create_test_team_scim.sh index 1df41191a35..b9ff9612770 100755 --- a/deploy/services-demo/create_test_team_scim.sh +++ b/deploy/services-demo/create_test_team_scim.sh @@ -23,7 +23,7 @@ USAGE: $0 # Option parsing: # https://sookocheff.com/post/bash/parsing-bash-script-arguments-with-shopts/ -while getopts ":n:h:c" opt; do +while getopts ":h:s:" opt; do case ${opt} in h ) BRIG_HOST="$OPTARG" ;; @@ -182,9 +182,13 @@ REGISTER_ACCEPT=$(cat <=0.5 - cryptohash-md5 >=0.11.7.2 - cryptohash-sha1 >=0.11.7.2 + - cryptonite >=0.26 - data-default >=0.5 - deepseq >=1.4 - directory >=1.2 @@ -54,6 +55,7 @@ library: - text >=0.11 - time >=1.6 - time-locale-compat >=0.1 + - tinylog >=0.14 - transformers >=0.3 - unix - unordered-containers >=0.2 diff --git a/libs/types-common/src/Util/Logging.hs b/libs/types-common/src/Util/Logging.hs new file mode 100644 index 00000000000..d06a36c89c8 --- /dev/null +++ b/libs/types-common/src/Util/Logging.hs @@ -0,0 +1,51 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2020 Wire Swiss GmbH +-- +-- 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 . + +module Util.Logging where + +import Crypto.Hash (SHA256, hash) +import Data.Handle (Handle (fromHandle)) +import Data.Id (TeamId, UserId) +import Data.String.Conversions (cs) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Imports +import qualified System.Logger.Class as Log +import System.Logger.Message (Msg) + +sha256String :: Text -> Text +sha256String t = + let digest = hash @ByteString @SHA256 (encodeUtf8 t) + in cs . show $ digest + +logHandle :: Handle -> (Msg -> Msg) +logHandle handl = + Log.field "handle_sha256" (sha256String . fromHandle $ handl) + +logFunction :: Text -> (Msg -> Msg) +logFunction fn = Log.field "fn" fn . Log.field "module" (getModule fn) + where + getModule :: Text -> Text + getModule t = case T.split (== '.') t of + [] -> "" + x -> T.intercalate "." (init x) + +logUser :: UserId -> (Msg -> Msg) +logUser uid = Log.field "user" (cs @_ @Text . show $ uid) + +logTeam :: TeamId -> (Msg -> Msg) +logTeam tid = Log.field "team" (cs @_ @Text . show $ tid) diff --git a/libs/types-common/types-common.cabal b/libs/types-common/types-common.cabal index 2a2a5f9b0a4..98fe357b8de 100644 --- a/libs/types-common/types-common.cabal +++ b/libs/types-common/types-common.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ee2619b6133e11f5de7ace09995fa308d2c5c6ecc46e81b8e10283594a7aef26 +-- hash: 74a96e1b02e343b15dc21c298af9a133f9e26b7e36335a91473acc75f4dff648 name: types-common version: 0.16.0 @@ -37,6 +37,7 @@ library Data.Text.Ascii Data.UUID.Tagged Util.Attoparsec + Util.Logging Util.Options Util.Options.Common Util.Test @@ -61,6 +62,7 @@ library , containers >=0.5 , cryptohash-md5 >=0.11.7.2 , cryptohash-sha1 >=0.11.7.2 + , cryptonite >=0.26 , data-default >=0.5 , deepseq >=1.4 , directory >=1.2 @@ -89,6 +91,7 @@ library , text >=0.11 , time >=1.6 , time-locale-compat >=0.1 + , tinylog >=0.14 , transformers >=0.3 , unix , unordered-containers >=0.2 diff --git a/nix/sources.json b/nix/sources.json index 796ea376117..b83549e22d0 100644 --- a/nix/sources.json +++ b/nix/sources.json @@ -17,10 +17,10 @@ "homepage": "https://github.com/NixOS/nixpkgs", "owner": "NixOS", "repo": "nixpkgs", - "rev": "502845c3e31ef3de0e424f3fcb09217df2ce6df6", - "sha256": "0fcqpsy6y7dgn0y0wgpa56gsg0b0p8avlpjrd79fp4mp9bl18nda", + "rev": "2080afd039999a58d60596d04cefb32ef5fcc2a2", + "sha256": "0i677swvj8fxfwg3jibd0xl33rn0rq0adnniim8jnp384whnh8ry", "type": "tarball", - "url": "https://github.com/NixOS/nixpkgs-channels/archive/502845c3e31ef3de0e424f3fcb09217df2ce6df6.tar.gz", + "url": "https://github.com/NixOS/nixpkgs/archive/2080afd039999a58d60596d04cefb32ef5fcc2a2.tar.gz", "url_template": "https://github.com///archive/.tar.gz" } } diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 8e3003035ab..8ee0de02d87 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -116,6 +116,7 @@ changeEmailError :: ChangeEmailError -> Error changeEmailError (InvalidNewEmail _ _) = StdError invalidEmail changeEmailError (EmailExists _) = StdError userKeyExists changeEmailError (ChangeBlacklistedEmail _) = StdError blacklistedEmail +changeEmailError EmailManagedByScim = StdError $ propertyManagedByScim "email" changePhoneError :: ChangePhoneError -> Error changePhoneError (InvalidNewPhone _) = StdError invalidPhone @@ -130,6 +131,7 @@ changeHandleError :: ChangeHandleError -> Error changeHandleError ChangeHandleNoIdentity = StdError (noIdentity 2) changeHandleError ChangeHandleExists = StdError handleExists changeHandleError ChangeHandleInvalid = StdError invalidHandle +changeHandleError ChangeHandleManagedByScim = StdError $ propertyManagedByScim "handle" legalHoldLoginError :: LegalHoldLoginError -> Error legalHoldLoginError LegalHoldLoginNoBindingTeam = StdError noBindingTeam @@ -207,6 +209,10 @@ phoneError PhoneNumberUnreachable = StdError invalidPhone phoneError PhoneNumberBarred = StdError blacklistedPhone phoneError (PhoneBudgetExhausted t) = RichError phoneBudgetExhausted (PhoneBudgetTimeout t) [] +updateProfileError :: UpdateProfileError -> Error +updateProfileError DisplayNameManagedByScim = StdError (propertyManagedByScim "name") +updateProfileError (ProfileNotFound _) = StdError userNotFound + -- WAI Errors ----------------------------------------------------------------- tooManyProperties :: Wai.Error @@ -427,6 +433,9 @@ insufficientTeamPermissions = Wai.Error status403 "insufficient-permissions" "In noBindingTeam :: Wai.Error noBindingTeam = Wai.Error status403 "no-binding-team" "Operation allowed only on binding teams" +propertyManagedByScim :: LText -> Wai.Error +propertyManagedByScim prop = Wai.Error status403 "managed-by-scim" $ "Updating \"" <> prop <> "\" is not allowed, because it is managed by SCIM" + sameBindingTeamUsers :: Wai.Error sameBindingTeamUsers = Wai.Error status403 "same-binding-team-users" "Operation not allowed to binding team users." diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 75617503521..e44aa998693 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -322,17 +322,17 @@ deleteUserNoVerify uid = do changeSelfEmailMaybeSendH :: UserId ::: Bool ::: JsonRequest EmailUpdate -> Handler Response changeSelfEmailMaybeSendH (u ::: validate ::: req) = do email <- euEmail <$> parseJsonBody req - changeSelfEmailMaybeSend u (if validate then ActuallySendEmail else DoNotSendEmail) email >>= \case + changeSelfEmailMaybeSend u (if validate then ActuallySendEmail else DoNotSendEmail) email API.AllowSCIMUpdates >>= \case ChangeEmailResponseIdempotent -> pure (setStatus status204 empty) ChangeEmailResponseNeedsActivation -> pure (setStatus status202 empty) data MaybeSendEmail = ActuallySendEmail | DoNotSendEmail -changeSelfEmailMaybeSend :: UserId -> MaybeSendEmail -> Email -> Handler ChangeEmailResponse -changeSelfEmailMaybeSend u ActuallySendEmail email = do - API.changeSelfEmail u email -changeSelfEmailMaybeSend u DoNotSendEmail email = do - API.changeEmail u email !>> changeEmailError >>= \case +changeSelfEmailMaybeSend :: UserId -> MaybeSendEmail -> Email -> API.AllowSCIMUpdates -> Handler ChangeEmailResponse +changeSelfEmailMaybeSend u ActuallySendEmail email allowScim = do + API.changeSelfEmail u email allowScim +changeSelfEmailMaybeSend u DoNotSendEmail email allowScim = do + API.changeEmail u email allowScim !>> changeEmailError >>= \case ChangeEmailIdempotent -> pure ChangeEmailResponseIdempotent ChangeEmailNeedsActivation _ -> pure ChangeEmailResponseNeedsActivation @@ -518,7 +518,7 @@ updateHandleH (uid ::: _ ::: body) = empty <$ (updateHandle uid =<< parseJsonBod updateHandle :: UserId -> HandleUpdate -> Handler () updateHandle uid (HandleUpdate handleUpd) = do handle <- validateHandle handleUpd - API.changeHandle uid Nothing handle !>> changeHandleError + API.changeHandle uid Nothing handle API.AllowSCIMUpdates !>> changeHandleError updateUserNameH :: UserId ::: JSON ::: JsonRequest NameUpdate -> Handler Response updateUserNameH (uid ::: _ ::: body) = empty <$ (updateUserName uid =<< parseJsonBody body) @@ -534,7 +534,7 @@ updateUserName uid (NameUpdate nameUpd) = do uupAccentId = Nothing } lift (Data.lookupUser WithPendingInvitations uid) >>= \case - Just _ -> lift $ API.updateUser uid Nothing uu + Just _ -> API.updateUser uid Nothing uu API.AllowSCIMUpdates !>> updateProfileError Nothing -> throwStd invalidUser checkHandleInternalH :: Text -> Handler Response @@ -547,7 +547,7 @@ checkHandleInternalH = getContactListH :: JSON ::: UserId -> Handler Response getContactListH (_ ::: uid) = do contacts <- lift $ API.lookupContactList uid - return $ json $ (UserIds contacts) + return $ json $ UserIds contacts -- Deprecated diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index e5afe1c95a5..9582ea4c181 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -37,6 +37,7 @@ import Brig.API.IdMapping (resolveOpaqueUserId) import qualified Brig.API.Properties as API import Brig.API.Types import qualified Brig.API.User as API +import Brig.API.Util import qualified Brig.API.Util as API import Brig.App import qualified Brig.Calling.API as Calling @@ -47,7 +48,7 @@ import qualified Brig.Team.API as Team import qualified Brig.Team.Email as Team import Brig.Types.Activation (ActivationPair) import Brig.Types.Intra (AccountStatus (Ephemeral), UserAccount (UserAccount, accountUser)) -import Brig.Types.User (HavePendingInvitations (..)) +import Brig.Types.User (HavePendingInvitations (..), User (userId)) import qualified Brig.User.API.Auth as Auth import qualified Brig.User.API.Search as Search import qualified Brig.User.Auth.Cookie as Auth @@ -91,6 +92,7 @@ import Servant.Swagger (HasSwagger (toSwagger)) import Servant.Swagger.Internal.Orphans () import Servant.Swagger.UI import qualified System.Logger.Class as Log +import Util.Logging (logFunction, logHandle, logTeam, logUser) import qualified Wire.API.Connection as Public import qualified Wire.API.Properties as Public import qualified Wire.API.Swagger as Public.Swagger (models) @@ -1142,7 +1144,7 @@ createUser (Public.NewUserPublic new) = do for_ (Public.newUserPhone new) $ checkWhitelist . Right result <- API.createUser new !>> newUserError let acc = createdAccount result - lift $ Log.debug (Log.msg $ "createUser: acc: " <> show acc) + let eac = createdEmailActivation result let pac = createdPhoneActivation result let epair = (,) <$> (activationKey <$> eac) <*> (activationCode <$> eac) @@ -1150,6 +1152,20 @@ createUser (Public.NewUserPublic new) = do let newUserLabel = Public.newUserLabel new let newUserTeam = Public.newUserTeam new let usr = accountUser acc + + let context = + let invitationCode = case Public.newUserTeam new of + (Just (Public.NewTeamMember code)) -> Just code + _ -> Nothing + in ( logFunction "Brig.API.Public.createUser" + . logUser (Public.userId usr) + . maybe id logHandle (Public.userHandle usr) + . maybe id logTeam (Public.userTeam usr) + . maybe id logEmail (Public.userEmail usr) + . maybe id logInvitationCode invitationCode + ) + Log.info $ context . Log.msg @Text "Sucessfully created user" + let Public.User {userLocale, userDisplayName, userId} = usr let userEmail = Public.userEmail usr let userPhone = Public.userPhone usr @@ -1274,7 +1290,7 @@ instance ToJSON GetActivationCodeResp where updateUserH :: UserId ::: ConnId ::: JsonRequest Public.UserUpdate -> Handler Response updateUserH (uid ::: conn ::: req) = do uu <- parseJsonBody req - lift $ API.updateUser uid (Just conn) uu + API.updateUser uid (Just conn) uu API.ForbidSCIMUpdates !>> updateProfileError return empty changePhoneH :: UserId ::: ConnId ::: JsonRequest Public.PhoneUpdate -> Handler Response @@ -1367,7 +1383,8 @@ changeHandleH (u ::: conn ::: req) = do changeHandle :: UserId -> ConnId -> Public.HandleUpdate -> Handler () changeHandle u conn (Public.HandleUpdate h) = do handle <- API.validateHandle h - API.changeHandle u (Just conn) handle !>> changeHandleError + -- TODO check here + API.changeHandle u (Just conn) handle API.ForbidSCIMUpdates !>> changeHandleError beginPasswordResetH :: JSON ::: JsonRequest Public.NewPasswordReset -> Handler Response beginPasswordResetH (_ ::: req) = do @@ -1418,7 +1435,7 @@ customerExtensionCheckBlockedDomains email = do changeSelfEmailH :: UserId ::: ConnId ::: JsonRequest Public.EmailUpdate -> Handler Response changeSelfEmailH (u ::: _ ::: req) = do email <- Public.euEmail <$> parseJsonBody req - API.changeSelfEmail u email >>= \case + API.changeSelfEmail u email API.ForbidSCIMUpdates >>= \case ChangeEmailResponseIdempotent -> pure (setStatus status204 empty) ChangeEmailResponseNeedsActivation -> pure (setStatus status202 empty) diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index 26372e2a329..af2ac7d8a46 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -103,6 +103,10 @@ data CreateUserError | -- | Some precondition on another Wire service failed. We propagate this error. ExternalPreconditionFailed Wai.Error +data UpdateProfileError + = DisplayNameManagedByScim + | ProfileNotFound UserId + data InvitationError = InviteeEmailExists UserId | InviteInvalidEmail Email @@ -163,11 +167,13 @@ data ChangeEmailError = InvalidNewEmail !Email !String | EmailExists !Email | ChangeBlacklistedEmail !Email + | EmailManagedByScim data ChangeHandleError = ChangeHandleNoIdentity | ChangeHandleExists | ChangeHandleInvalid + | ChangeHandleManagedByScim data SendActivationCodeError = InvalidRecipient UserKey diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index e8875dc65b1..af00ab5179a 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/services/brig/src/Brig/API/User.hs @@ -56,6 +56,7 @@ module Brig.API.User checkHandles, isBlacklistedHandle, Data.reauthenticate, + AllowSCIMUpdates (..), -- * Activation sendActivationCode, @@ -147,6 +148,11 @@ import Network.Wai.Utilities import qualified System.Logger.Class as Log import System.Logger.Message +data AllowSCIMUpdates + = AllowSCIMUpdates + | ForbidSCIMUpdates + deriving (Show, Eq, Ord) + ------------------------------------------------------------------------------- -- Create User @@ -394,13 +400,20 @@ checkRestrictedUserCreation new = do ------------------------------------------------------------------------------- -- Update Profile --- FUTUREWORK: this and other functions should refuse to modify a ManagedByScim user. See --- {#SparBrainDump} https://github.com/zinfra/backend-issues/issues/1632 - -updateUser :: UserId -> Maybe ConnId -> UserUpdate -> AppIO () -updateUser uid mconn uu = do - Data.updateUser uid uu - Intra.onUserEvent uid mconn (profileUpdated uid uu) +updateUser :: UserId -> Maybe ConnId -> UserUpdate -> AllowSCIMUpdates -> ExceptT UpdateProfileError AppIO () +updateUser uid mconn uu allowScim = do + for_ (uupName uu) $ \newName -> do + mbUser <- lift $ Data.lookupUser WithPendingInvitations uid + user <- maybe (throwE (ProfileNotFound uid)) pure mbUser + unless + ( userManagedBy user /= ManagedByScim + || userDisplayName user == newName + || allowScim == AllowSCIMUpdates + ) + $ throwE DisplayNameManagedByScim + lift $ do + Data.updateUser uid uu + Intra.onUserEvent uid mconn (profileUpdated uid uu) ------------------------------------------------------------------------------- -- Update Locale @@ -421,14 +434,21 @@ changeManagedBy uid conn (ManagedByUpdate mb) = do -------------------------------------------------------------------------------- -- Change Handle -changeHandle :: UserId -> Maybe ConnId -> Handle -> ExceptT ChangeHandleError AppIO () -changeHandle uid mconn hdl = do +changeHandle :: UserId -> Maybe ConnId -> Handle -> AllowSCIMUpdates -> ExceptT ChangeHandleError AppIO () +changeHandle uid mconn hdl allowScim = do when (isBlacklistedHandle hdl) $ throwE ChangeHandleInvalid usr <- lift $ Data.lookupUser WithPendingInvitations uid case usr of Nothing -> throwE ChangeHandleNoIdentity - Just u -> claim u + Just u -> do + unless + ( userManagedBy u /= ManagedByScim + || Just hdl == userHandle u + || allowScim == AllowSCIMUpdates + ) + $ throwE ChangeHandleManagedByScim + claim u where claim u = do unless (isJust (userIdentity u)) $ @@ -487,9 +507,9 @@ checkHandles check num = reverse <$> collectFree [] check num -- | Call 'changeEmail' and process result: if email changes to itself, succeed, if not, send -- validation email. -changeSelfEmail :: UserId -> Email -> ExceptT Error.Error AppIO ChangeEmailResponse -changeSelfEmail u email = do - changeEmail u email !>> Error.changeEmailError >>= \case +changeSelfEmail :: UserId -> Email -> AllowSCIMUpdates -> ExceptT Error.Error AppIO ChangeEmailResponse +changeSelfEmail u email allowScim = do + changeEmail u email allowScim !>> Error.changeEmailError >>= \case ChangeEmailIdempotent -> pure ChangeEmailResponseIdempotent ChangeEmailNeedsActivation (usr, adata, en) -> do @@ -505,8 +525,8 @@ changeSelfEmail u email = do (userIdentity usr) -- | Prepare changing the email (checking a number of invariants). -changeEmail :: UserId -> Email -> ExceptT ChangeEmailError AppIO ChangeEmailResult -changeEmail u email = do +changeEmail :: UserId -> Email -> AllowSCIMUpdates -> ExceptT ChangeEmailError AppIO ChangeEmailResult +changeEmail u email allowScim = do em <- either (throwE . InvalidNewEmail email) @@ -525,6 +545,11 @@ changeEmail u email = do -- The user already has an email address and the new one is exactly the same Just current | current == em -> return ChangeEmailIdempotent _ -> do + unless + ( userManagedBy usr /= ManagedByScim + || allowScim == AllowSCIMUpdates + ) + $ throwE EmailManagedByScim timeout <- setActivationTimeout <$> view settings act <- lift $ Data.newActivation ek timeout (Just u) return $ ChangeEmailNeedsActivation (usr, act, em) diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs index 7ed69980210..358f5d665e1 100644 --- a/services/brig/src/Brig/API/Util.hs +++ b/services/brig/src/Brig/API/Util.hs @@ -19,7 +19,9 @@ module Brig.API.Util ( fetchUserIdentity, lookupProfilesMaybeFilterSameTeamOnly, lookupSelfProfile, + logInvitationCode, validateHandle, + logEmail, ) where @@ -35,7 +37,12 @@ import Control.Monad.Trans.Except (throwE) import Data.Handle (Handle, parseHandle) import Data.Id import Data.Maybe +import Data.String.Conversions (cs) +import Data.Text.Ascii (AsciiText (toText)) import Imports +import System.Logger (Msg) +import qualified System.Logger as Log +import Util.Logging (sha256String) lookupProfilesMaybeFilterSameTeamOnly :: UserId -> [UserProfile] -> Handler [UserProfile] lookupProfilesMaybeFilterSameTeamOnly self us = do @@ -59,3 +66,10 @@ lookupSelfProfile = fmap (fmap mk) . Data.lookupAccount validateHandle :: Text -> Handler Handle validateHandle = maybe (throwE (Error.StdError Error.invalidHandle)) return . parseHandle + +logEmail :: Email -> (Msg -> Msg) +logEmail email = + Log.field "email_sha256" (sha256String . cs . show $ email) + +logInvitationCode :: InvitationCode -> (Msg -> Msg) +logInvitationCode code = Log.field "invitation_code" (toText $ fromInvitationCode code) diff --git a/services/brig/src/Brig/Team/API.hs b/services/brig/src/Brig/Team/API.hs index b9e7a024cd0..30a3df314ce 100644 --- a/services/brig/src/Brig/Team/API.hs +++ b/services/brig/src/Brig/Team/API.hs @@ -25,6 +25,7 @@ import Brig.API.Error import Brig.API.Handler import Brig.API.User (createUserInviteViaScim, fetchUserIdentity) import qualified Brig.API.User as API +import Brig.API.Util (logEmail, logInvitationCode) import Brig.App (currentTime, emailSender, settings) import qualified Brig.Data.Blacklist as Blacklist import Brig.Data.UserKey @@ -42,11 +43,13 @@ import Brig.Types.Team.Invitation import Brig.Types.User (Email, InvitationCode, emailIdentity) import qualified Brig.User.Search.Index as ESIndex import Control.Lens (view, (^.)) +import Control.Monad.Trans.Except (mapExceptT) import Data.Aeson hiding (json) import Data.ByteString.Conversion import Data.Id import qualified Data.List1 as List1 import Data.Range +import Data.String.Conversions (cs) import qualified Data.Swagger.Build.Api as Doc import qualified Galley.Types.Teams as Team import qualified Galley.Types.Teams.Intra as Team @@ -58,6 +61,9 @@ import Network.Wai.Routing import Network.Wai.Utilities hiding (code, message) import Network.Wai.Utilities.Swagger (document) import qualified Network.Wai.Utilities.Swagger as Doc +import System.Logger (Msg) +import qualified System.Logger.Class as Log +import Util.Logging (logFunction, logTeam) import qualified Wire.API.Team.Invitation as Public import qualified Wire.API.Team.Role as Public import qualified Wire.API.User as Public @@ -230,7 +236,15 @@ createInvitationPublic uid tid body = do ensurePermissionToAddUser uid tid inviteePerms pure $ CreateInvitationInviter uid from - createInvitation' tid inviteeRole (Just (inviterUid inviter)) (inviterEmail inviter) body + let context = + logFunction "Brig.Team.API.createInvitationPublic" + . logTeam tid + . logEmail (irInviteeEmail body) + + fst + <$> logInvitationRequest + context + (createInvitation' tid inviteeRole (Just (inviterUid inviter)) (inviterEmail inviter) body) createInvitationViaScimH :: JSON ::: JsonRequest NewUserScimInvitation -> Handler Response createInvitationViaScimH (_ ::: req) = do @@ -250,11 +264,32 @@ createInvitationViaScim newUser@(NewUserScimInvitation tid loc name email) = do irInviteeEmail = email, irInviteePhone = Nothing } - inv <- createInvitation' tid inviteeRole Nothing fromEmail invreq + + let context = + logFunction "Brig.Team.API.createInvitationViaScim" + . logTeam tid + . logEmail email + + (inv, _) <- + logInvitationRequest context $ + createInvitation' tid inviteeRole Nothing fromEmail invreq let uid = Id (toUUID (inInvitation inv)) + createUserInviteViaScim uid newUser -createInvitation' :: TeamId -> Public.Role -> Maybe UserId -> Email -> Public.InvitationRequest -> Handler Public.Invitation +logInvitationRequest :: (Msg -> Msg) -> Handler (Invitation, InvitationCode) -> Handler (Invitation, InvitationCode) +logInvitationRequest context action = + flip mapExceptT action $ \action' -> do + eith <- action' + case eith of + Left err' -> do + Log.err $ context . Log.msg @Text ("Failed to create invitation, label: " <> (cs . label . waiError) err') + pure (Left err') + Right result@(_, code) -> do + Log.info $ (context . logInvitationCode code) . Log.msg @Text "Succesfully created invitation" + pure (Right result) + +createInvitation' :: TeamId -> Public.Role -> Maybe UserId -> Email -> Public.InvitationRequest -> Handler (Public.Invitation, Public.InvitationCode) createInvitation' tid inviteeRole mbInviterUid fromEmail body = do -- FUTUREWORK: These validations are nearly copy+paste from accountCreation and -- sendActivationCode. Refactor this to a single place @@ -303,7 +338,7 @@ createInvitation' tid inviteeRole mbInviterUid fromEmail body = do inviteeName inviteePhone timeout - newInv <$ sendInvitationMail inviteeEmail tid fromEmail code locale + (newInv, code) <$ sendInvitationMail inviteeEmail tid fromEmail code locale deleteInvitationH :: JSON ::: UserId ::: TeamId ::: InvitationId -> Handler Response deleteInvitationH (_ ::: uid ::: tid ::: iid) = do diff --git a/services/spar/src/Spar/Intra/Brig.hs b/services/spar/src/Spar/Intra/Brig.hs index 32588aaba55..bfa165310bf 100644 --- a/services/spar/src/Spar/Intra/Brig.hs +++ b/services/spar/src/Spar/Intra/Brig.hs @@ -20,11 +20,10 @@ -- | Client functions for interacting with the Brig API. module Spar.Intra.Brig ( veidToUserSSOId, - veidFromUserSSOId, urefToExternalId, urefToEmail, - userToExternalId, veidFromBrigUser, + veidFromUserSSOId, mkUserName, renderValidExternalId, emailFromSAML, @@ -119,17 +118,6 @@ urefToEmail uref = case uref ^. SAML.uidSubject . SAML.nameID of SAML.UNameIDEmail email -> Just $ emailFromSAML email _ -> Nothing -userToExternalId :: MonadError String m => User -> m Text -userToExternalId usr = - case veidFromUserSSOId <$> userSSOId usr of - Nothing -> throwError "brig user without sso_id" - Just (Left err) -> throwError err - Just (Right veid) -> - runValidExternalId - (\(SAML.UserRef _ subj) -> maybe (throwError "bad uref from brig") pure $ SAML.shortShowNameID subj) - (pure . fromEmail) - veid - -- | If the brig user has a 'UserSSOId', transform that into a 'ValidExternalId' (this is a -- total function as long as brig obeys the api). Otherwise, if the user has an email, we can -- construct a return value from that (and an optional saml issuer). If a user only has a diff --git a/services/spar/src/Spar/Scim/User.hs b/services/spar/src/Spar/Scim/User.hs index d2c05f399d9..f1c0827ce35 100644 --- a/services/spar/src/Spar/Scim/User.hs +++ b/services/spar/src/Spar/Scim/User.hs @@ -48,6 +48,7 @@ import qualified Brig.Types.User as BT import qualified Control.Applicative as Applicative (empty) import Control.Lens (view, (^.)) import Control.Monad.Except (MonadError, throwError) +import Control.Monad.Trans.Except (mapExceptT) import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT) import Crypto.Hash (Digest, SHA256, hashlazy) import qualified Data.Aeson as Aeson @@ -67,7 +68,9 @@ import Spar.Scim.Auth () import qualified Spar.Scim.Types as ST import Spar.Types (IdP, ScimTokenInfo (..), derivedOpts, derivedOptsScimBaseURI, richInfoLimit) import qualified System.Logger.Class as Log +import System.Logger.Message (Msg) import qualified URI.ByteString as URIBS +import Util.Logging (logFunction, logHandle, logTeam, logUser, sha256String) import qualified Web.Scim.Class.User as Scim import qualified Web.Scim.Filter as Scim import qualified Web.Scim.Handler as Scim @@ -78,6 +81,7 @@ import qualified Web.Scim.Schema.Meta as Scim import qualified Web.Scim.Schema.ResourceType as Scim import qualified Web.Scim.Schema.User as Scim import qualified Web.Scim.Schema.User as Scim.User (schemas) +import Wire.API.User (Email) import qualified Wire.API.User.RichInfo as RI ---------------------------------------------------------------------------- @@ -90,32 +94,43 @@ instance Scim.UserDB ST.SparTag Spar where Scim.ScimHandler Spar (Scim.ListResponse (Scim.StoredUser ST.SparTag)) getUsers _ Nothing = do throwError $ Scim.badRequest Scim.TooMany (Just "Please specify a filter when getting users.") - getUsers ScimTokenInfo {stiTeam, stiIdP} (Just filter') = do - lift $ Log.debug (Log.msg $ "getUsers" <> show (stiTeam, stiIdP, filter')) - mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP - case filter' of - Scim.FilterAttrCompare (Scim.AttrPath schema attrName _subAttr) Scim.OpEq (Scim.ValString val) - | Scim.isUserSchema schema -> do - x <- runMaybeT $ case attrName of - "username" -> scimFindUserByHandle mIdpConfig stiTeam val - "externalid" -> scimFindUserByEmail mIdpConfig stiTeam val - _ -> throwError (Scim.badRequest Scim.InvalidFilter (Just "Unsupported attribute")) - pure $ Scim.fromList (toList x) - | otherwise -> throwError $ Scim.badRequest Scim.InvalidFilter (Just "Unsupported schema") - _ -> throwError $ Scim.badRequest Scim.InvalidFilter (Just "Operation not supported") + getUsers tokeninfo@ScimTokenInfo {stiTeam, stiIdP} (Just filter') = + logScim + ( logFunction "Spar.Scim.User.getUsers" + . logTokenInfo tokeninfo + . Log.msg ("filters: " <> show filter') + ) + $ do + mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP + case filter' of + Scim.FilterAttrCompare (Scim.AttrPath schema attrName _subAttr) Scim.OpEq (Scim.ValString val) + | Scim.isUserSchema schema -> do + x <- runMaybeT $ case attrName of + "username" -> scimFindUserByHandle mIdpConfig stiTeam val + "externalid" -> scimFindUserByEmail mIdpConfig stiTeam val + _ -> throwError (Scim.badRequest Scim.InvalidFilter (Just "Unsupported attribute")) + pure $ Scim.fromList (toList x) + | otherwise -> throwError $ Scim.badRequest Scim.InvalidFilter (Just "Unsupported schema") + _ -> throwError $ Scim.badRequest Scim.InvalidFilter (Just "Operation not supported") getUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag) - getUser ScimTokenInfo {stiTeam, stiIdP} uid = do - mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP - let notfound = Scim.notFound "User" (idToText uid) - brigUser <- lift (Brig.getBrigUserAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure - unless (userTeam (accountUser brigUser) == Just stiTeam) (throwError notfound) - case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of - Right veid -> synthesizeStoredUser brigUser veid - Left _ -> throwError notfound + getUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = + logScim + ( logFunction "Spar.Scim.User.getUser" + . logUser uid + . logTokenInfo tokeninfo + ) + $ do + mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP + let notfound = Scim.notFound "User" (idToText uid) + brigUser <- lift (Brig.getBrigUserAccount Brig.WithPendingInvitations uid) >>= maybe (throwError notfound) pure + unless (userTeam (accountUser brigUser) == Just stiTeam) (throwError notfound) + case Brig.veidFromBrigUser (accountUser brigUser) ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of + Right veid -> synthesizeStoredUser brigUser veid + Left _ -> throwError notfound postUser :: ScimTokenInfo -> @@ -132,7 +147,13 @@ instance Scim.UserDB ST.SparTag Spar where updateValidScimUser tokinfo uid =<< validateScimUser tokinfo newScimUser deleteUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler Spar () - deleteUser = deleteScimUser + deleteUser tokeninfo uid = + logScim + ( logFunction "Spar.Scim.User.deleteUser" + . logUser uid + . logTokenInfo tokeninfo + ) + $ deleteScimUser tokeninfo uid ---------------------------------------------------------------------------- -- User creation and validation @@ -279,6 +300,41 @@ mkValidExternalId (Just idp) (Just extid) = do Scim.InvalidValue (Just $ "Can't construct a subject ID from externalId: " <> Text.pack err) +logScim :: forall m a. (m ~ Scim.ScimHandler Spar) => (Msg -> Msg) -> m a -> m a +logScim context action = + flip mapExceptT action $ \action' -> do + eith <- action' + case eith of + Left e -> do + let errorMsg = + case Scim.detail e of + Just d -> d + Nothing -> cs (Aeson.encode e) + Log.err $ context . Log.msg errorMsg + pure (Left e) + Right x -> do + Log.info $ context . Log.msg @Text "call without exception" + pure (Right x) + +logEmail :: Email -> (Msg -> Msg) +logEmail email = + Log.field "email_sha256" (sha256String . cs . show $ email) + +logVSU :: ST.ValidScimUser -> (Msg -> Msg) +logVSU (ST.ValidScimUser veid handl _name _richInfo _active) = + maybe id logEmail (veidEmail veid) + . logHandle handl + +logTokenInfo :: ScimTokenInfo -> (Msg -> Msg) +logTokenInfo ScimTokenInfo {stiTeam} = logTeam stiTeam + +veidEmail :: ST.ValidExternalId -> Maybe Email +veidEmail (ST.EmailAndUref email _) = Just email +veidEmail (ST.UrefOnly _) = Nothing +veidEmail (ST.EmailOnly email) = Just email + +-- in ScimTokenHash (cs @ByteString @Text (convertToBase Base64 digest)) + -- | Creates a SCIM User. -- -- User is created in Brig first, and then in SCIM and SAML. @@ -301,74 +357,80 @@ createValidScimUser :: ScimTokenInfo -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) -createValidScimUser ScimTokenInfo {stiTeam} (ST.ValidScimUser veid handl name richInfo _) = do - -- ensure uniqueness constraints of all affected identifiers. - -- {if we crash now, retry POST will just work} - assertExternalIdUnused veid - assertHandleUnused handl - -- {if we crash now, retry POST will just work, or user gets told the handle - -- is already in use and stops POSTing} - - -- Generate a UserId will be used both for scim user in spar and for brig. - buid <- - lift $ do +createValidScimUser tokeninfo@ScimTokenInfo {stiTeam} vsu@(ST.ValidScimUser veid handl name richInfo _) = + logScim + ( logFunction "Spar.Scim.User.createValidScimUser" + . logVSU vsu + . logTokenInfo tokeninfo + ) + $ do + -- ensure uniqueness constraints of all affected identifiers. + -- {if we crash now, retry POST will just work} + assertExternalIdUnused veid + assertHandleUnused handl + -- {if we crash now, retry POST will just work, or user gets told the handle + -- is already in use and stops POSTing} + + -- Generate a UserId will be used both for scim user in spar and for brig. buid <- + lift $ do + buid <- + ST.runValidExternalId + ( \uref -> + do + uid <- liftIO $ Id <$> UUID.nextRandom + Brig.createBrigUserSAML uref uid stiTeam name ManagedByScim + ) + ( \email -> do + Brig.createBrigUserNoSAML email stiTeam name + ) + veid + + Log.debug (Log.msg $ "createValidScimUser: brig says " <> show buid) + + -- {If we crash now, we have an active user that cannot login. And can not + -- be bound this will be a zombie user that needs to be manually cleaned + -- up. We should consider making setUserHandle part of createUser and + -- making it transactional. If the user redoes the POST A new standalone + -- user will be created.} + Brig.setBrigUserHandle buid handl + Brig.setBrigUserRichInfo buid richInfo + pure buid + + -- {If we crash now, a POST retry will fail with 409 user already exists. + -- Azure at some point will retry with GET /Users?filter=userName eq handle + -- and then issue a PATCH containing the rich info and the externalId.} + + -- By now, vsu that was passed to 'createValidScimUser' may be outdated. Eg., if user is + -- invited via scim, we have @active == True@ above, but brig has stored the account in + -- @AccountStatus == PendingActivation@, which translates to @active == False@. So we need + -- to reload the Account from brig. + storedUser <- do + acc <- + lift (Brig.getBrigUserAccount Brig.WithPendingInvitations buid) + >>= maybe (throwError $ Scim.serverError "Server error: user vanished") pure + synthesizeStoredUser acc veid + lift $ Log.debug (Log.msg $ "createValidScimUser: spar says " <> show storedUser) + + -- {(arianvp): these two actions we probably want to make transactional.} + lift . wrapMonadClient $ do + -- Store scim timestamps, saml credentials, scim externalId locally in spar. + Data.writeScimUserTimes storedUser ST.runValidExternalId - ( \uref -> - do - uid <- liftIO $ Id <$> UUID.nextRandom - Brig.createBrigUserSAML uref uid stiTeam name ManagedByScim - ) - ( \email -> do - Brig.createBrigUserNoSAML email stiTeam name - ) + (`Data.insertSAMLUser` buid) + (`Data.insertScimExternalId` buid) veid - Log.debug (Log.msg $ "createValidScimUser: brig says " <> show buid) - - -- {If we crash now, we have an active user that cannot login. And can not - -- be bound this will be a zombie user that needs to be manually cleaned - -- up. We should consider making setUserHandle part of createUser and - -- making it transactional. If the user redoes the POST A new standalone - -- user will be created.} - Brig.setBrigUserHandle buid handl - Brig.setBrigUserRichInfo buid richInfo - pure buid - - -- {If we crash now, a POST retry will fail with 409 user already exists. - -- Azure at some point will retry with GET /Users?filter=userName eq handle - -- and then issue a PATCH containing the rich info and the externalId.} - - -- By now, vsu that was passed to 'createValidScimUser' may be outdated. Eg., if user is - -- invited via scim, we have @active == True@ above, but brig has stored the account in - -- @AccountStatus == PendingActivation@, which translates to @active == False@. So we need - -- to reload the Account from brig. - storedUser <- do - acc <- - lift (Brig.getBrigUserAccount Brig.WithPendingInvitations buid) - >>= maybe (throwError $ Scim.serverError "Server error: user vanished") pure - synthesizeStoredUser acc veid - lift $ Log.debug (Log.msg $ "createValidScimUser: spar says " <> show storedUser) - - -- {(arianvp): these two actions we probably want to make transactional.} - lift . wrapMonadClient $ do - -- Store scim timestamps, saml credentials, scim externalId locally in spar. - Data.writeScimUserTimes storedUser - ST.runValidExternalId - (`Data.insertSAMLUser` buid) - (`Data.insertScimExternalId` buid) - veid - - -- If applicable, trigger email validation procedure on brig. - lift $ ST.runValidExternalId (validateEmailIfExists buid) (\_ -> pure ()) veid - - -- {suspension via scim: if we don't reach the following line, the user will be active.} - lift $ do - old <- Brig.getStatus buid - let new = ST.scimActiveFlagToAccountStatus old (Scim.unScimBool <$> active) - active = Scim.active . Scim.value . Scim.thing $ storedUser - when (new /= old) $ Brig.setStatus buid new - pure storedUser + -- If applicable, trigger email validation procedure on brig. + lift $ ST.runValidExternalId (validateEmailIfExists buid) (\_ -> pure ()) veid + + -- {suspension via scim: if we don't reach the following line, the user will be active.} + lift $ do + old <- Brig.getStatus buid + let new = ST.scimActiveFlagToAccountStatus old (Scim.unScimBool <$> active) + active = Scim.active . Scim.value . Scim.thing $ storedUser + when (new /= old) $ Brig.setStatus buid new + pure storedUser -- TODO(arianvp): how do we get this safe w.r.t. race conditions / crashes? updateValidScimUser :: @@ -378,47 +440,53 @@ updateValidScimUser :: UserId -> ST.ValidScimUser -> m (Scim.StoredUser ST.SparTag) -updateValidScimUser tokinfo uid newValidScimUser = do - -- lookup updatee - oldScimStoredUser :: Scim.StoredUser ST.SparTag <- - Scim.getUser tokinfo uid - oldValidScimUser :: ST.ValidScimUser <- - validateScimUser tokinfo . Scim.value . Scim.thing $ oldScimStoredUser - - -- assertions about new valid scim user that cannot be checked in 'validateScimUser' because - -- they differ from the ones in 'createValidScimUser'. - assertExternalIdNotUsedElsewhere (newValidScimUser ^. ST.vsuExternalId) uid - assertHandleNotUsedElsewhere uid (newValidScimUser ^. ST.vsuHandle) - - if oldValidScimUser == newValidScimUser - then pure oldScimStoredUser - else lift $ do - newScimStoredUser :: Scim.StoredUser ST.SparTag <- - updScimStoredUser (synthesizeScimUser newValidScimUser) oldScimStoredUser - - case ( oldValidScimUser ^. ST.vsuExternalId, - newValidScimUser ^. ST.vsuExternalId - ) of - (old, new) | old /= new -> updateVsuUref uid old new - _ -> pure () - - when (newValidScimUser ^. ST.vsuName /= oldValidScimUser ^. ST.vsuName) $ do - Brig.setBrigUserName uid (newValidScimUser ^. ST.vsuName) - - when (oldValidScimUser ^. ST.vsuHandle /= newValidScimUser ^. ST.vsuHandle) $ do - Brig.setBrigUserHandle uid (newValidScimUser ^. ST.vsuHandle) - - when (oldValidScimUser ^. ST.vsuRichInfo /= newValidScimUser ^. ST.vsuRichInfo) $ do - Brig.setBrigUserRichInfo uid (newValidScimUser ^. ST.vsuRichInfo) - - Brig.getStatusMaybe uid >>= \case - Nothing -> pure () - Just old -> do - let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive) - when (new /= old) $ Brig.setStatus uid new - - wrapMonadClient $ Data.writeScimUserTimes newScimStoredUser - pure newScimStoredUser +updateValidScimUser tokinfo uid newValidScimUser = + logScim + ( logFunction "Spar.Scim.User.updateValidScimUser" + . logVSU newValidScimUser + . logUser uid + . logTokenInfo tokinfo + ) + $ do + oldScimStoredUser :: Scim.StoredUser ST.SparTag <- + Scim.getUser tokinfo uid + oldValidScimUser :: ST.ValidScimUser <- + validateScimUser tokinfo . Scim.value . Scim.thing $ oldScimStoredUser + + -- assertions about new valid scim user that cannot be checked in 'validateScimUser' because + -- they differ from the ones in 'createValidScimUser'. + assertExternalIdNotUsedElsewhere (newValidScimUser ^. ST.vsuExternalId) uid + assertHandleNotUsedElsewhere uid (newValidScimUser ^. ST.vsuHandle) + + if oldValidScimUser == newValidScimUser + then pure oldScimStoredUser + else lift $ do + newScimStoredUser :: Scim.StoredUser ST.SparTag <- + updScimStoredUser (synthesizeScimUser newValidScimUser) oldScimStoredUser + + case ( oldValidScimUser ^. ST.vsuExternalId, + newValidScimUser ^. ST.vsuExternalId + ) of + (old, new) | old /= new -> updateVsuUref uid old new + _ -> pure () + + when (newValidScimUser ^. ST.vsuName /= oldValidScimUser ^. ST.vsuName) $ do + Brig.setBrigUserName uid (newValidScimUser ^. ST.vsuName) + + when (oldValidScimUser ^. ST.vsuHandle /= newValidScimUser ^. ST.vsuHandle) $ do + Brig.setBrigUserHandle uid (newValidScimUser ^. ST.vsuHandle) + + when (oldValidScimUser ^. ST.vsuRichInfo /= newValidScimUser ^. ST.vsuRichInfo) $ do + Brig.setBrigUserRichInfo uid (newValidScimUser ^. ST.vsuRichInfo) + + Brig.getStatusMaybe uid >>= \case + Nothing -> pure () + Just old -> do + let new = ST.scimActiveFlagToAccountStatus old (Just $ newValidScimUser ^. ST.vsuActive) + when (new /= old) $ Brig.setStatus uid new + + wrapMonadClient $ Data.writeScimUserTimes newScimStoredUser + pure newScimStoredUser updateVsuUref :: UserId -> @@ -491,37 +559,42 @@ updScimStoredUser' now usr (Scim.WithMeta meta (Scim.WithId scimuid _)) = Scim.version = calculateVersion scimuid usr } -deleteScimUser :: - ScimTokenInfo -> UserId -> Scim.ScimHandler Spar () -deleteScimUser ScimTokenInfo {stiTeam} uid = do - mbBrigUser <- lift (Brig.getBrigUser Brig.WithPendingInvitations uid) - case mbBrigUser of - Nothing -> do - -- double-deletion gets you a 404. - throwError $ Scim.notFound "user" (idToText uid) - Just brigUser -> do - -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM - -- (because that owner won't be managed by SCIM in the first place), but if it ever becomes - -- possible, we should do a check here and prohibit it. - unless (userTeam brigUser == Just stiTeam) $ - -- users from other teams get you a 404. - throwError $ - Scim.notFound "user" (idToText uid) - for_ (BT.userSSOId brigUser) $ \ssoId -> do - veid <- either logThenServerError pure $ Brig.veidFromUserSSOId ssoId - lift . wrapMonadClient $ - ST.runValidExternalId - Data.deleteSAMLUser - Data.deleteScimExternalId - veid - lift . wrapMonadClient $ Data.deleteScimUserTimes uid - lift $ Brig.deleteBrigUser uid - return () - where - logThenServerError :: String -> Scim.ScimHandler Spar b - logThenServerError err = do - lift $ Log.err (Log.msg $ "deleteScimUser: " <> err) - throwError $ Scim.serverError "Server Error" +deleteScimUser :: ScimTokenInfo -> UserId -> Scim.ScimHandler Spar () +deleteScimUser tokeninfo@ScimTokenInfo {stiTeam, stiIdP} uid = + logScim + ( logFunction "Spar.Scim.User.deleteScimUser" + . logTokenInfo tokeninfo + . logUser uid + ) + $ do + mbBrigUser <- lift (Brig.getBrigUser Brig.WithPendingInvitations uid) + case mbBrigUser of + Nothing -> do + -- double-deletion gets you a 404. + throwError $ Scim.notFound "user" (idToText uid) + Just brigUser -> do + -- FUTUREWORK: currently it's impossible to delete the last available team owner via SCIM + -- (because that owner won't be managed by SCIM in the first place), but if it ever becomes + -- possible, we should do a check here and prohibit it. + unless (userTeam brigUser == Just stiTeam) $ + -- users from other teams get you a 404. + throwError $ + Scim.notFound "user" (idToText uid) + + mIdpConfig <- maybe (pure Nothing) (lift . wrapMonadClient . Data.getIdPConfig) stiIdP + + case Brig.veidFromBrigUser brigUser ((^. SAML.idpMetadata . SAML.edIssuer) <$> mIdpConfig) of + Left _ -> pure () + Right veid -> + lift . wrapMonadClient $ + ST.runValidExternalId + Data.deleteSAMLUser + Data.deleteScimExternalId + veid + + lift . wrapMonadClient $ Data.deleteScimUserTimes uid + lift $ Brig.deleteBrigUser uid + return () ---------------------------------------------------------------------------- -- Utilities @@ -587,46 +660,54 @@ assertHandleNotUsedElsewhere uid hndl = do -- effects like updating the 'ManagedBy' field in brig and storing creation and update time -- stamps. synthesizeStoredUser :: UserAccount -> ST.ValidExternalId -> Scim.ScimHandler Spar (Scim.StoredUser ST.SparTag) -synthesizeStoredUser usr veid = do - let uid = userId (accountUser usr) - accStatus = accountStatus usr - - let readState :: Spar (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI) - readState = do - richInfo <- Brig.getBrigUserRichInfo uid - accessTimes <- wrapMonadClient (Data.readScimUserTimes uid) - baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts - pure (richInfo, accessTimes, baseuri) - - let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar () - writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do - when (isNothing oldAccessTimes) $ do - wrapMonadClient $ Data.writeScimUserTimes storedUser - when (oldManagedBy /= ManagedByScim) $ do - Brig.setBrigUserManagedBy uid ManagedByScim - let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser - when (oldRichInfo /= newRichInfo) $ do - Brig.setBrigUserRichInfo uid newRichInfo - - (richInfo, accessTimes, baseuri) <- lift readState - SAML.Time (toUTCTimeMillis -> now) <- lift SAML.getNow - let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes - - handle <- lift $ Brig.giveDefaultHandle (accountUser usr) - - storedUser <- - synthesizeStoredUser' - uid - veid - (userDisplayName (accountUser usr)) - handle - richInfo - accStatus - createdAt - lastUpdatedAt - baseuri - lift $ writeState accessTimes (userManagedBy (accountUser usr)) richInfo storedUser - pure storedUser +synthesizeStoredUser usr veid = + logScim + ( logFunction "Spar.Scim.User.synthesizeStoredUser" + . logUser (userId . accountUser $ usr) + . maybe id logHandle (userHandle . accountUser $ usr) + . maybe id logTeam (userTeam . accountUser $ usr) + . maybe id logEmail (veidEmail veid) + ) + $ do + let uid = userId (accountUser usr) + accStatus = accountStatus usr + + let readState :: Spar (RI.RichInfo, Maybe (UTCTimeMillis, UTCTimeMillis), URIBS.URI) + readState = do + richInfo <- Brig.getBrigUserRichInfo uid + accessTimes <- wrapMonadClient (Data.readScimUserTimes uid) + baseuri <- asks $ derivedOptsScimBaseURI . derivedOpts . sparCtxOpts + pure (richInfo, accessTimes, baseuri) + + let writeState :: Maybe (UTCTimeMillis, UTCTimeMillis) -> ManagedBy -> RI.RichInfo -> Scim.StoredUser ST.SparTag -> Spar () + writeState oldAccessTimes oldManagedBy oldRichInfo storedUser = do + when (isNothing oldAccessTimes) $ do + wrapMonadClient $ Data.writeScimUserTimes storedUser + when (oldManagedBy /= ManagedByScim) $ do + Brig.setBrigUserManagedBy uid ManagedByScim + let newRichInfo = view ST.sueRichInfo . Scim.extra . Scim.value . Scim.thing $ storedUser + when (oldRichInfo /= newRichInfo) $ do + Brig.setBrigUserRichInfo uid newRichInfo + + (richInfo, accessTimes, baseuri) <- lift readState + SAML.Time (toUTCTimeMillis -> now) <- lift SAML.getNow + let (createdAt, lastUpdatedAt) = fromMaybe (now, now) accessTimes + + handle <- lift $ Brig.giveDefaultHandle (accountUser usr) + + storedUser <- + synthesizeStoredUser' + uid + veid + (userDisplayName (accountUser usr)) + handle + richInfo + accStatus + createdAt + lastUpdatedAt + baseuri + lift $ writeState accessTimes (userManagedBy (accountUser usr)) richInfo storedUser + pure storedUser synthesizeStoredUser' :: UserId -> diff --git a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs index 66d5020068f..5edf796443c 100644 --- a/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/UserSpec.hs @@ -32,8 +32,11 @@ import Bilge import Bilge.Assert import Brig.Types.Intra (AccountStatus (Active, PendingInvitation, Suspended), accountStatus, accountUser) import Brig.Types.User as Brig +import Cassandra import qualified Control.Exception import Control.Lens +import Control.Monad.Except (MonadError (throwError)) +import Control.Monad.Random (Random (randomRIO)) import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe import Control.Retry (exponentialBackoff, limitRetries, recovering) @@ -47,8 +50,10 @@ import Data.Ix (inRange) import Data.String.Conversions (cs) import Data.Text.Encoding (encodeUtf8) import Imports +import qualified Network.Wai.Utilities.Error as Wai import qualified SAML2.WebSSO.Test.MockResponse as SAML import qualified SAML2.WebSSO.Types as SAML +import Spar.Data (lookupScimExternalId) import qualified Spar.Data as Data import qualified Spar.Intra.Brig as Intra import Spar.Scim @@ -81,6 +86,7 @@ spec = do specAzureQuirks specEmailValidation specSuspend + specSCIMManaged describe "CRUD operations maintain invariants in mapScimToBrig, mapBrigToScim." $ do it "..." $ do pendingWith "this is a job for quickcheck-state-machine" @@ -193,7 +199,7 @@ specCreateUser = describe "POST /Users" $ do context "team has one SAML IdP" $ do it "creates a user in an existing team" $ do testCreateUserWithSamlIdP - it "adds a Wire scheme to the user record" $ testSchemaIsAdded + it "adds a Wire scheme to the user record" $ testSchemaIsAdded it "requires externalId to be present" $ testExternalIdIsRequired it "rejects invalid handle" $ testCreateRejectsInvalidHandle it "rejects occupied handle" $ testCreateRejectsTakenHandle @@ -732,7 +738,7 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do runSpar $ Intra.setBrigUserHandle uid handle pure usr let memberIdWithSSO = userId memberWithSSO - externalId = either error id $ Intra.userToExternalId memberWithSSO + externalId = either error id $ veidToText =<< Intra.veidFromBrigUser memberWithSSO Nothing -- NOTE: once SCIM is enabled, SSO auto-provisioning is disabled tok <- registerScimToken teamid (Just (idp ^. SAML.idpId)) @@ -742,6 +748,13 @@ testFindSamlAutoProvisionedUserMigratedWithEmailInTeamWithSSO = do liftIO $ (scimUserId <$> users) `shouldContain` [memberIdWithSSO] Just brigUser' <- runSpar $ Intra.getBrigUser Intra.NoPendingInvitations memberIdWithSSO liftIO $ userManagedBy brigUser' `shouldBe` ManagedByScim + where + veidToText :: MonadError String m => ValidExternalId -> m Text + veidToText veid = + runValidExternalId + (\(SAML.UserRef _ subj) -> maybe (throwError "bad uref from brig") pure $ SAML.shortShowNameID subj) + (pure . fromEmail) + veid testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO :: TestSpar () testFindTeamSettingsInvitedUserMigratedWithEmailInTeamWithSSO = do @@ -1546,6 +1559,10 @@ specDeleteUser = do aFewTimes (getUser_ (Just tok) uid spar) ((== 404) . statusCode) !!! const 404 === statusCode + context "No IDP" $ do + describe "Deleting a User" $ do + it "should release their externalId" testDeletedUsersFreeExternalIdNoIdp + -- | Azure sends a request for an unknown user to test out whether your API is online However; -- it sends a userName that is not a valid wire handle. So we should treat 'invalid' as 'not -- found'. @@ -1594,3 +1611,74 @@ specEmailValidation = do context "not enabled in team" . it "does not give user email" $ do (uid, _) <- setup False eventually $ checkEmail uid Nothing + +testDeletedUsersFreeExternalIdNoIdp :: TestSpar () +testDeletedUsersFreeExternalIdNoIdp = do + env <- ask + let brig = env ^. teBrig + let spar = env ^. teSpar + let clientState = env ^. teCql + + (_owner, tid) <- call $ createUserWithTeam (env ^. teBrig) (env ^. teGalley) + tok <- registerScimToken tid Nothing + + email <- randomEmail + scimUser <- randomScimUser <&> \u -> u {Scim.User.externalId = Just $ fromEmail email} + scimStoredUser <- createUser tok scimUser + let uid = scimUserId scimStoredUser + userName = Name . fromJust . Scim.User.displayName $ scimUser + + -- accept invitation + do + inv <- call $ getInvitation brig email + Just inviteeCode <- call $ getInvitationCode brig tid (inInvitation inv) + registerInvitation email userName inviteeCode True + call $ headInvitation404 brig email + + -- delete user + deleteUser_ (Just tok) (Just uid) spar + !!! const 204 === statusCode + + void $ + aFewTimes + (runClient clientState $ lookupScimExternalId email) + (== Nothing) + +specSCIMManaged :: SpecWith TestEnv +specSCIMManaged = do + describe "SCIM-managed users" $ do + it "cannot manually update their email, handle or name" $ do + env <- ask + let brig = env ^. teBrig + + (tok, _) <- registerIdPAndScimToken + user <- randomScimUser + storedUser <- createUser tok user + let uid = Scim.id . Scim.thing $ storedUser + + do + email <- randomEmail + call $ + changeEmailBrig brig uid email !!! do + (fmap Wai.label . responseJsonEither @Wai.Error) === const (Right "managed-by-scim") + statusCode === const 403 + + do + handleTxt <- randomAlphaNum + call $ + changeHandleBrig brig uid handleTxt !!! do + (fmap Wai.label . responseJsonEither @Wai.Error) === const (Right "managed-by-scim") + statusCode === const 403 + + do + displayName <- Name <$> randomAlphaNum + let uupd = UserUpdate (Just displayName) Nothing Nothing Nothing + call $ + updateProfileBrig brig uid uupd !!! do + (fmap Wai.label . responseJsonEither @Wai.Error) === const (Right "managed-by-scim") + statusCode === const 403 + where + randomAlphaNum :: MonadIO m => m Text + randomAlphaNum = liftIO $ do + nrs <- replicateM 21 (randomRIO (97, 122)) -- a-z + return (cs (map chr nrs)) diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index 3fe3566dec2..14a500108f7 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -52,6 +52,8 @@ module Util.Core randomEmail, defPassword, getUserBrig, + changeHandleBrig, + updateProfileBrig, createUserWithTeam, createUserWithTeamDisableSSO, getSSOEnabledInternal, @@ -71,6 +73,7 @@ module Util.Core nextUserRef, createRandomPhoneUser, zUser, + zConn, ping, makeTestIdP, getTestSPMetadata, @@ -192,6 +195,7 @@ import qualified Web.Cookie as Web import Wire.API.Team.Feature (TeamFeatureStatusValue (..)) import qualified Wire.API.Team.Feature as Public import qualified Wire.API.Team.Invitation as TeamInvitation +import Wire.API.User (HandleUpdate (HandleUpdate), UserUpdate) import qualified Wire.API.User as User -- | Call 'mkEnv' with options from config files. @@ -1203,3 +1207,35 @@ stdInvitationRequest = stdInvitationRequest' Nothing Nothing stdInvitationRequest' :: Maybe User.Locale -> Maybe Galley.Role -> User.Email -> TeamInvitation.InvitationRequest stdInvitationRequest' loc role email = TeamInvitation.InvitationRequest loc role Nothing email Nothing + +changeHandleBrig :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + BrigReq -> + UserId -> + Text -> + m ResponseLBS +changeHandleBrig brig uid handlTxt = do + put + ( brig + . path "/self/handle" + . zUser uid + . zConn "user" + . contentJson + . json (HandleUpdate handlTxt) + ) + +updateProfileBrig :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + BrigReq -> + UserId -> + UserUpdate -> + m ResponseLBS +updateProfileBrig brig uid uupd = + put + ( brig + . path "/self" + . zUser uid + . zConn "user" + . contentJson + . json uupd + ) diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs index b6e18429583..921808d7796 100644 --- a/services/spar/test-integration/Util/Email.hs +++ b/services/spar/test-integration/Util/Email.hs @@ -33,6 +33,22 @@ import Util.Core import Util.Types import qualified Wire.API.Team.Feature as Feature +changeEmailBrig :: + (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => + BrigReq -> + UserId -> + Email -> + m ResponseLBS +changeEmailBrig brig uid email = do + put + ( brig + . path "/self/email" + . zUser uid + . zConn "user" + . contentJson + . json (EmailUpdate email) + ) + activateEmail :: (MonadCatch m, MonadIO m, MonadHttp m, HasCallStack) => BrigReq -> diff --git a/shell.nix b/shell.nix index b16d1ad7d76..a042e815aa2 100644 --- a/shell.nix +++ b/shell.nix @@ -5,5 +5,6 @@ with pkgs; mkShell { docker-compose gnumake stack + haskell-language-server ]; }