Block changes to some user data in mlsE2EId teams (WPB-6189)

- Integration tests
- block changes in the backend.
- lie about managed_by in `GET /self`, but only there.

changelog.d/1-api-changes/WPB-6189

@@ -0,0 +1 @@
+Block changes of userDisplayName, userHandle in mlsE2EI-enabled teams on the backend without SCIM; report `"managed_by" == "scim"` in `GET /self`, but only there

integration/integration.cabal

@@ -99,6 +99,7 @@ library
     API.Gundeck
     API.GundeckInternal
     API.Nginz
+    API.Spar
     MLS.Util
     Notifications
     RunAllTests

integration/test/API/Brig.hs

@@ -109,6 +109,7 @@ addUser dom opts = do
           "password" .= fromMaybe defPassword opts.password
         ]
 
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_users__uid_domain___uid_
 getUser ::
   (HasCallStack, MakesValue user, MakesValue target) =>
   user ->
@@ -147,12 +148,6 @@ deleteUser user = do
   submit "DELETE" $
     req & addJSONObject ["password" .= defPassword]
 
-putHandle :: (HasCallStack, MakesValue user) => user -> String -> App Response
-putHandle user handle = do
-  req <- baseRequest user Brig Versioned "/self/handle"
-  submit "PUT" $
-    req & addJSONObject ["handle" .= handle]
-
 data AddClient = AddClient
   { ctype :: String,
     internal :: Bool,
@@ -398,12 +393,67 @@ replaceKeyPackages cid suites kps = do
       & addQueryParams [("ciphersuites", intercalate "," (map (.code) suites))]
       & addJSONObject ["key_packages" .= map (T.decodeUtf8 . Base64.encode) kps]
 
-getSelf :: HasCallStack => String -> String -> App Response
-getSelf domain uid = do
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_self
+getSelf :: (HasCallStack, MakesValue caller) => caller -> App Response
+getSelf caller = do
+  req <- baseRequest caller Brig Versioned "/self"
+  submit "GET" req
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_self
+-- this is a low-level version of `getSelf` for testing some error conditions.
+getSelf' :: HasCallStack => String -> String -> App Response
+getSelf' domain uid = do
   let user = object ["domain" .= domain, "id" .= uid]
   req <- baseRequest user Brig Versioned "/self"
   submit "GET" req
 
+data PutSelf = PutSelf
+  { accent :: Maybe Int,
+    assets :: Maybe [Value], -- [{"key":"string", "size":"string", "type":"string"}]
+    name :: Maybe String,
+    picture :: Maybe [String]
+  }
+
+instance Default PutSelf where
+  def = PutSelf Nothing Nothing Nothing Nothing
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/put_self
+putSelf :: (HasCallStack, MakesValue caller) => caller -> PutSelf -> App Response
+putSelf caller body = do
+  req <- baseRequest caller Brig Versioned "/self"
+  submit "PUT" $
+    req
+      & addJSONObject
+        [ "accent_id" .= body.accent,
+          "assets" .= body.assets,
+          "name" .= body.name,
+          "picture" .= body.picture
+        ]
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/put_self_locale
+putSelfLocale :: (HasCallStack, MakesValue caller) => caller -> String -> App Response
+putSelfLocale caller locale = do
+  req <- baseRequest caller Brig Versioned "/self/locale"
+  submit "PUT" $ req & addJSONObject ["locale" .= locale]
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/put_users__uid__email
+--
+-- NOTE: the full process of changing (and confirming) the email address is more complicated.
+-- see /services/brig/test/integration for details.
+putSelfEmail :: (HasCallStack, MakesValue caller) => caller -> String -> App Response
+putSelfEmail caller emailAddress = do
+  callerid <- asString $ caller %. "id"
+  req <- baseRequest caller Brig Versioned $ joinHttpPath ["users", callerid, "email"]
+  submit "PUT" $ req & addJSONObject ["email" .= emailAddress]
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/put_self_handle
+-- FUTUREWORK: rename to putSelfHandle for consistency
+putHandle :: (HasCallStack, MakesValue user) => user -> String -> App Response
+putHandle user handle = do
+  req <- baseRequest user Brig Versioned "/self/handle"
+  submit "PUT" $
+    req & addJSONObject ["handle" .= handle]
+
 getUserSupportedProtocols ::
   (HasCallStack, MakesValue user, MakesValue target) =>
   user ->

integration/test/API/BrigInternal.hs

@@ -52,6 +52,12 @@ createUser domain cu = do
                ]
         )
 
+-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users
+getUsersId :: (HasCallStack, MakesValue domain) => domain -> [String] -> App Response
+getUsersId domain ids = do
+  req <- baseRequest domain Brig Unversioned "/i/users"
+  submit "GET" $ req & addQueryParams [("ids", intercalate "," ids)]
+
 data FedConn = FedConn
   { domain :: String,
     searchStrategy :: String,

integration/test/API/Spar.hs

@@ -0,0 +1,10 @@
+module API.Spar where
+
+import GHC.Stack
+import Testlib.Prelude
+
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_scim_auth_tokens
+getScimTokens :: (HasCallStack, MakesValue caller) => caller -> App Response
+getScimTokens caller = do
+  req <- baseRequest caller Spar Versioned "/scim/auth-tokens"
+  submit "GET" req

integration/test/Test/Demo.hs

@@ -105,7 +105,7 @@ testDynamicBackend = do
   ownDomain <- objDomain OwnDomain
   user <- randomUser OwnDomain def
   uid <- objId user
-  bindResponse (BrigP.getSelf ownDomain uid) $ \resp -> do
+  bindResponse (BrigP.getSelf' ownDomain uid) $ \resp -> do
     resp.status `shouldMatchInt` 200
     (resp.json %. "id") `shouldMatch` objId user
 
@@ -117,18 +117,18 @@ testDynamicBackend = do
         resp.json %. "setRestrictUserCreation" `shouldMatch` False
 
     -- user created in own domain should not be found in dynamic backend
-    bindResponse (BrigP.getSelf dynDomain uid) $ \resp -> do
+    bindResponse (BrigP.getSelf' dynDomain uid) $ \resp -> do
       resp.status `shouldMatchInt` 404
 
     -- now create a user in the dynamic backend
     userD1 <- randomUser dynDomain def
     uidD1 <- objId userD1
-    bindResponse (BrigP.getSelf dynDomain uidD1) $ \resp -> do
+    bindResponse (BrigP.getSelf' dynDomain uidD1) $ \resp -> do
       resp.status `shouldMatchInt` 200
       (resp.json %. "id") `shouldMatch` objId userD1
 
     -- the d1 user should not be found in the own domain
-    bindResponse (BrigP.getSelf ownDomain uidD1) $ \resp -> do
+    bindResponse (BrigP.getSelf' ownDomain uidD1) $ \resp -> do
       resp.status `shouldMatchInt` 404
 
 testStartMultipleDynamicBackends :: HasCallStack => App ()

integration/test/Test/User.hs

@@ -1,7 +1,13 @@
+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
+
 module Test.User where
 
 import API.Brig
 import API.BrigInternal
+import API.GalleyInternal
+import API.Spar
+import qualified Data.UUID as UUID
+import qualified Data.UUID.V4 as UUID
 import SetupHelpers
 import Testlib.Prelude
 
@@ -47,3 +53,120 @@ testCreateUserSupportedProtocols = do
   bindResponse (createUser OwnDomain def {supportedProtocols = Just ["proteus", "mixed"]}) $ \resp -> do
     resp.status `shouldMatchInt` 400
     resp.json %. "label" `shouldMatch` "bad-request"
+
+-- | For now this only tests attempts to update /self/handle in E2EId-enabled teams.  More
+-- tests can be found under `/services/brig/test/integration` (and should be moved here).
+testUpdateHandle :: HasCallStack => App ()
+testUpdateHandle = do
+  -- create team with one member, without scim, but with `mlsE2EId` enabled.
+  (owner, team, [mem1]) <- createTeam OwnDomain 2
+  mem1id <- asString $ mem1 %. "id"
+
+  let featureName = "mlsE2EId"
+  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "disabled"
+  setTeamFeatureStatus owner team featureName "enabled"
+  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "enabled"
+
+  -- all as expected here.  (see the second time we check this at the end of the test for an
+  -- explanation why we care.)
+  bindResponse (getSelf mem1) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "managed_by" `shouldMatch` "wire"
+  bindResponse (getUsersId owner [mem1id]) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    mb <- (assertOne =<< asList resp.json) %. "managed_by"
+    mb `shouldMatch` "wire"
+
+  -- mem1 attempts to update handle for the first time => success
+  --
+  -- this is desired, because without SCIM users need to pick their own handles initially.
+  -- moreover it is fine, because if `handle == NULL`, no mls E2Eid client certs can be
+  -- created.
+  handle <- UUID.toString <$> liftIO UUID.nextRandom
+  bindResponse (putHandle mem1 handle) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+  bindResponse (putHandle mem1 handle) $ \resp -> do
+    -- idempotency
+    resp.status `shouldMatchInt` 200
+
+  -- mem1 attempts to update handle again => failure
+  handle2 <- UUID.toString <$> liftIO UUID.nextRandom
+  bindResponse (putHandle mem1 handle2) $ \resp -> do
+    resp.status `shouldMatchInt` 403
+    resp.json %. "label" `shouldMatch` "managed-by-scim"
+
+  -- now self thinks it is managed by "scim", so clients can block change attempts to handle,
+  -- display name without adding E2EId-specific logic.  this is just a hack, though: `GET
+  -- /self` is the only place where this is happening, other end-points still report the truth
+  -- that is still stored correctly in the DB.
+  --
+  -- details: https://wearezeta.atlassian.net/browse/WPB-6189.
+  -- FUTUREWORK: figure out a better way for clients to detect E2EId (V6?)
+  bindResponse (getSelf mem1) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "managed_by" `shouldMatch` "scim"
+  bindResponse (getUsersId owner [mem1id]) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    mb <- (assertOne =<< asList resp.json) %. "managed_by"
+    mb `shouldMatch` "wire"
+  bindResponse (getScimTokens owner) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "tokens" `shouldMatch` ([] @String)
+
+-- | For now this only tests attempts to update one's own display name, email address, or
+-- language in E2EId-enabled teams (ie., everything except handle).  More tests can be found
+-- under `/services/brig/test/integration` (and should be moved here).
+testUpdateSelf :: HasCallStack => TestUpdateSelfMode -> App ()
+testUpdateSelf mode = do
+  -- create team with one member, without scim, but with `mlsE2EId` enabled.
+  (owner, team, [mem1]) <- createTeam OwnDomain 2
+
+  let featureName = "mlsE2EId"
+  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "disabled"
+  setTeamFeatureStatus owner team featureName "enabled"
+  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "status" `shouldMatch` "enabled"
+
+  case mode of
+    TestUpdateDisplayName -> do
+      -- blocked unconditionally
+      someDisplayName <- UUID.toString <$> liftIO UUID.nextRandom
+      before <- getSelf mem1
+      bindResponse (putSelf mem1 def {name = Just someDisplayName}) $ \resp -> do
+        resp.status `shouldMatchInt` 403
+        resp.json %. "label" `shouldMatch` "managed-by-scim"
+      after <- getSelf mem1
+      void $ (before.json %. "name") `shouldMatch` (after.json %. "name")
+    TestUpdateEmailAddress -> do
+      -- allowed unconditionally *for owner* (this is a bit off-topic: team members can't
+      -- change their email addresses themselves under any conditions)
+      someEmail <- (<> "@example.com") . UUID.toString <$> liftIO UUID.nextRandom
+      bindResponse (putSelfEmail owner someEmail) $ \resp -> do
+        resp.status `shouldMatchInt` 200
+    TestUpdateLocale -> do
+      -- scim maps "User.preferredLanguage" to brig's locale field.  allowed unconditionally.
+      -- we try two languages to make sure it doesn't work because it's already the active
+      -- locale.
+      forM_ ["uk", "he"] $ \someLocale ->
+        bindResponse (putSelfLocale mem1 someLocale) $ \resp -> do
+          resp.status `shouldMatchInt` 200
+
+data TestUpdateSelfMode
+  = TestUpdateDisplayName
+  | TestUpdateEmailAddress
+  | TestUpdateLocale
+  deriving (Eq, Show, Bounded, Enum)
+
+instance HasTests x => HasTests (TestUpdateSelfMode -> x) where
+  mkTests m n s f x =
+    mconcat
+      [ mkTests m (n <> "[mode=" <> show mode <> "]") s f (x mode)
+        | mode <- [minBound ..]
+      ]

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

@@ -680,13 +680,13 @@ getRichInfoMultiH :: Maybe (CommaSeparatedList UserId) -> (Handler r) [(UserId,
 getRichInfoMultiH (maybe [] fromCommaSeparatedList -> uids) =
   lift $ wrapClient $ API.lookupRichInfoMultiUsers uids
 
-updateHandleH :: UserId -> HandleUpdate -> (Handler r) NoContent
+updateHandleH :: Member GalleyProvider r => UserId -> HandleUpdate -> (Handler r) NoContent
 updateHandleH uid (HandleUpdate handleUpd) =
   NoContent <$ do
     handle <- validateHandle handleUpd
     API.changeHandle uid Nothing handle API.AllowSCIMUpdates !>> changeHandleError
 
-updateUserNameH :: UserId -> NameUpdate -> (Handler r) NoContent
+updateUserNameH :: Member GalleyProvider r => UserId -> NameUpdate -> (Handler r) NoContent
 updateUserNameH uid (NameUpdate nameUpd) =
   NoContent <$ do
     name <- either (const $ throwStd (errorToWai @'E.InvalidUser)) pure $ mkName nameUpd

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

@@ -746,10 +746,11 @@ createUser (Public.NewUserPublic new) = lift . runExceptT $ do
       Public.NewTeamMemberSSO _ ->
         Team.sendMemberWelcomeMail e t n l
 
-getSelf :: UserId -> (Handler r) Public.SelfProfile
+getSelf :: Member GalleyProvider r => UserId -> (Handler r) Public.SelfProfile
 getSelf self =
   lift (API.lookupSelfProfile self)
     >>= ifNothing (errorToWai @'E.UserNotFound)
+    >>= lift . liftSem . API.hackForBlockingHandleChangeForE2EIdTeams
 
 getUserUnqualifiedH ::
   (Member GalleyProvider r) =>
@@ -861,7 +862,7 @@ newtype GetActivationCodeResp
 instance ToJSON GetActivationCodeResp where
   toJSON (GetActivationCodeResp (k, c)) = object ["key" .= k, "code" .= c]
 
-updateUser :: UserId -> ConnId -> Public.UserUpdate -> (Handler r) (Maybe Public.UpdateProfileError)
+updateUser :: Member GalleyProvider r => UserId -> ConnId -> Public.UserUpdate -> (Handler r) (Maybe Public.UpdateProfileError)
 updateUser uid conn uu = do
   eithErr <- lift $ runExceptT $ API.updateUser uid (Just conn) uu API.ForbidSCIMUpdates
   pure $ either Just (const Nothing) eithErr
@@ -932,7 +933,7 @@ getHandleInfoUnqualifiedH self handle = do
   Public.UserHandleInfo . Public.profileQualifiedId
     <$$> Handle.getHandleInfo self (Qualified handle domain)
 
-changeHandle :: UserId -> ConnId -> Public.HandleUpdate -> (Handler r) (Maybe Public.ChangeHandleError)
+changeHandle :: Member GalleyProvider r => UserId -> ConnId -> Public.HandleUpdate -> (Handler r) (Maybe Public.ChangeHandleError)
 changeHandle u conn (Public.HandleUpdate h) = lift . exceptTToMaybe $ do
   handle <- maybe (throwError Public.ChangeHandleInvalid) pure $ parseHandle h
   API.changeHandle u (Just conn) handle API.ForbidSCIMUpdates