Merge branch 'wireapp:develop' into develop

cassandra-schema.cql

@@ -666,7 +666,8 @@ CREATE TABLE brig_test.user (
     status int,
     supported_protocols int,
     team uuid,
-    text_status text
+    text_status text,
+    write_time_bumper int
 ) WITH bloom_filter_fp_chance = 0.1
     AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'}
     AND comment = ''

changelog.d/3-bug-fixes/WPB-11122-disallow-searching-user-by-old-email

@@ -0,0 +1 @@
+Users with SAML-SSO are allowed to delete their email address on the rest api. If they do that, the search indices are not updated correctly, and finding the user by the removed email address is still possible.

integration/test/API/Brig.hs

@@ -249,6 +249,13 @@ searchContacts user searchTerm domain = do
   d <- objDomain domain
   submit "GET" (req & addQueryParams [("q", q), ("domain", d)])
 
+-- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_teams__tid__search
+searchTeam :: (HasCallStack, MakesValue user) => user -> String -> App Response
+searchTeam user q = do
+  tid <- user %. "team" & asString
+  req <- baseRequest user Brig Versioned $ joinHttpPath ["teams", tid, "search"]
+  submit "GET" (req & addQueryParams [("q", q)])
+
 getAPIVersion :: (HasCallStack, MakesValue domain) => domain -> App Response
 getAPIVersion domain = do
   req <- baseRequest domain Brig Unversioned $ "/api-version"
@@ -402,6 +409,12 @@ putSelfEmail caller emailAddress = do
   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/delete_self_email
+deleteSelfEmail :: (HasCallStack, MakesValue caller) => caller -> App Response
+deleteSelfEmail caller = do
+  req <- baseRequest caller Brig Versioned $ joinHttpPath ["self", "email"]
+  submit "DELETE" req
+
 -- | 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

integration/test/API/Spar.hs

@@ -12,7 +12,7 @@ getScimTokens caller = do
   req <- baseRequest caller Spar Versioned "/scim/auth-tokens"
   submit "GET" req
 
--- https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_scim_auth_tokens
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/post_scim_auth_tokens
 createScimToken :: (HasCallStack, MakesValue caller) => caller -> App Response
 createScimToken caller = do
   req <- baseRequest caller Spar Versioned "/scim/auth-tokens"

integration/test/Test/Brig.hs

@@ -1,14 +1,20 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+
 module Test.Brig where
 
-import API.Brig
+import API.Brig as BrigP
 import qualified API.BrigInternal as BrigI
 import API.Common
+import API.GalleyInternal (setTeamFeatureStatus)
+import API.Spar
 import Data.Aeson.Types hiding ((.=))
 import Data.List.Split
 import Data.String.Conversions
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as UUID
 import GHC.Stack
+import SAML2.WebSSO.Test.Util (SampleIdP (..), makeSampleIdPMetadata)
 import SetupHelpers
 import System.IO.Extra
 import Testlib.Assertions
@@ -229,3 +235,37 @@ testSFTFederation = do
           maybe (assertFailure "is_federating missing") asBool
             =<< lookupField resp.json "is_federating"
         when isFederating $ assertFailure "is_federating should be false"
+
+testDeleteEmail :: (HasCallStack) => App ()
+testDeleteEmail = do
+  (owner, tid, [usr]) <- createTeam OwnDomain 2
+  putSelf usr (PutSelf Nothing Nothing (Just "Alice") Nothing) >>= assertSuccess
+  email <- getSelf usr >>= getJSON 200 >>= (%. "email") >>= asString
+
+  let associateUsrWithSSO :: (HasCallStack) => App ()
+      associateUsrWithSSO = do
+        void $ setTeamFeatureStatus owner tid "sso" "enabled"
+        registerTestIdPWithMeta owner >>= assertSuccess
+        tok <- createScimToken owner >>= getJSON 200 >>= (%. "token") >>= asString
+        void $ findUsersByExternalId owner tok email
+
+      searchShouldBe :: (HasCallStack) => String -> App ()
+      searchShouldBe expected = do
+        BrigI.refreshIndex OwnDomain
+        bindResponse (BrigP.searchTeam owner email) $ \resp -> do
+          resp.status `shouldMatchInt` 200
+          numDocs <- length <$> (resp.json %. "documents" >>= asList)
+          case expected of
+            "empty" -> numDocs `shouldMatchInt` 0
+            "non-empty" -> numDocs `shouldMatchInt` 1
+
+  deleteSelfEmail usr >>= assertStatus 403
+  searchShouldBe "non-empty"
+  associateUsrWithSSO
+  deleteSelfEmail usr >>= assertSuccess
+  searchShouldBe "empty"
+
+registerTestIdPWithMeta :: (HasCallStack, MakesValue owner) => owner -> App Response
+registerTestIdPWithMeta owner = do
+  SampleIdP idpmeta _ _ _ <- makeSampleIdPMetadata
+  createIdp owner idpmeta

libs/cassandra-util/src/Cassandra/Util.hs

@@ -109,7 +109,7 @@ initCassandra settings Nothing logger = do
 -- | Read cassandra's writetimes https://docs.datastax.com/en/dse/5.1/cql/cql/cql_using/useWritetime.html
 -- as UTCTime values without any loss of precision
 newtype Writetime a = Writetime {writetimeToUTC :: UTCTime}
-  deriving (Functor)
+  deriving (Eq, Show, Functor)
 
 instance Cql (Writetime a) where
   ctype = Tagged BigIntColumn

libs/types-common/default.nix

@@ -47,6 +47,7 @@
 , tasty
 , tasty-hunit
 , tasty-quickcheck
+, template-haskell
 , text
 , time
 , time-locale-compat
@@ -102,6 +103,7 @@ mkDerivation {
     tagged
     tasty
     tasty-hunit
+    template-haskell
     text
     time
     time-locale-compat

libs/types-common/src/Util/SuffixNamer.hs

@@ -0,0 +1,10 @@
+module Util.SuffixNamer where
+
+import Control.Lens
+import Imports
+import Language.Haskell.TH (mkName, nameBase)
+
+suffixNamer :: FieldNamer
+suffixNamer _ _ n =
+  let name = nameBase n
+   in [TopName (mkName (name <> "Lens"))]

libs/types-common/types-common.cabal

@@ -38,6 +38,7 @@ library
     Util.Logging
     Util.Options
     Util.Options.Common
+    Util.SuffixNamer
     Util.Test
     Util.Timeout
     Wire.Arbitrary
@@ -132,6 +133,7 @@ library
     , tagged                 >=0.8
     , tasty                  >=0.11
     , tasty-hunit
+    , template-haskell
     , text                   >=0.11
     , time                   >=1.6
     , time-locale-compat     >=0.1

libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs

@@ -186,10 +186,9 @@ type AccountAPI =
     :<|> Named
            "putSelfEmail"
            ( Summary
-               "internal email activation (used in tests and in spar for validating emails obtained as \
-               \SAML user identifiers).  if the validate query parameter is false or missing, only set \
-               \the activation timeout, but do not send an email, and do not do anything about \
-               \activating the email."
+               "Internal email update and activation. Used in tests and in spar for validating emails \
+               \obtained via scim or saml implicit user creation. If the `validate` query parameter is \
+               \false or missing, only update the email and do not activate."
                :> ZUser
                :> "self"
                :> "email"

libs/wire-subsystems/src/Wire/UserSearch/Types.hs

@@ -205,3 +205,18 @@ data BrowseTeamFilters = BrowseTeamFilters
 
 userIdToDocId :: UserId -> DocId
 userIdToDocId uid = DocId (idToText uid)
+
+-- | We use cassandra writetimes to construct the ES index version. Since nulling fields in
+-- cassandra also nulls the writetime, re-indexing does not happen when nulling a field, and
+-- the old search key can still effectively be used.
+--
+-- `write_time_bumper type int` is an extra field that we can update whenever we null a field
+-- and want to update the write time of the table.  `WriteTimeBumper` writes to 'int' fields,
+-- but only cares about the field's writetime.
+data WriteTimeBumper = WriteTimeBumper
+  deriving (Eq, Show)
+
+instance C.Cql WriteTimeBumper where
+  ctype = C.Tagged C.IntColumn
+  toCql WriteTimeBumper = C.CqlInt 0
+  fromCql _ = pure WriteTimeBumper

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

@@ -55,7 +55,7 @@ getIndexUserBaseQuery :: LText
 getIndexUserBaseQuery =
   [sql|
     SELECT
-    id, 
+    id,
     team, writetime(team),
     name, writetime(name),
     status, writetime(status),
@@ -66,7 +66,8 @@ getIndexUserBaseQuery =
     service, writetime(service),
     managed_by, writetime(managed_by),
     sso_id, writetime(sso_id),
-    email_unvalidated, writetime(email_unvalidated)
+    email_unvalidated, writetime(email_unvalidated),
+    writetime(write_time_bumper)
     FROM user
   |]
 

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

@@ -22,6 +22,7 @@ import Wire.UserSearch.Types
 type Activated = Bool
 
 data WithWritetime a = WithWriteTime {value :: a, writetime :: Writetime a}
+  deriving (Eq, Show)
 
 data IndexUser = IndexUser
   { userId :: UserId,
@@ -35,8 +36,10 @@ data IndexUser = IndexUser
     serviceId :: Maybe (WithWritetime ServiceId),
     managedBy :: Maybe (WithWritetime ManagedBy),
     ssoId :: Maybe (WithWritetime UserSSOId),
-    unverifiedEmail :: Maybe (WithWritetime EmailAddress)
+    unverifiedEmail :: Maybe (WithWritetime EmailAddress),
+    writeTimeBumper :: Maybe (Writetime WriteTimeBumper)
   }
+  deriving (Eq, Show)
 
 {- ORMOLU_DISABLE -}
 type instance
@@ -52,12 +55,13 @@ type instance
       Maybe ServiceId, Maybe (Writetime ServiceId),
       Maybe ManagedBy, Maybe (Writetime ManagedBy),
       Maybe UserSSOId, Maybe (Writetime UserSSOId),
-      Maybe EmailAddress, Maybe (Writetime EmailAddress)
+      Maybe EmailAddress, Maybe (Writetime EmailAddress),
+      Maybe (Writetime WriteTimeBumper)
     )
 
 instance Record IndexUser where
   asTuple (IndexUser {..}) =
-    ( userId, 
+    ( userId,
       value <$> teamId, writetime <$> teamId,
       name.value, name.writetime,
       value <$> accountStatus, writetime <$> accountStatus,
@@ -68,11 +72,12 @@ instance Record IndexUser where
       value <$> serviceId, writetime <$> serviceId,
       value <$> managedBy, writetime <$> managedBy,
       value <$> ssoId, writetime <$> ssoId,
-      value <$> unverifiedEmail, writetime <$> unverifiedEmail
+      value <$> unverifiedEmail, writetime <$> unverifiedEmail,
+      writeTimeBumper
     )
 
   asRecord
-    ( u, 
+    ( u,
       mTeam, tTeam,
       name, tName,
       status, tStatus,
@@ -83,7 +88,8 @@ instance Record IndexUser where
       service, tService,
       managedBy, tManagedBy,
       ssoId, tSsoId,
-      emailUnvalidated, tEmailUnvalidated
+      emailUnvalidated, tEmailUnvalidated,
+      tWriteTimeBumper
     ) = IndexUser {
           userId = u,
           teamId =  WithWriteTime <$> mTeam <*> tTeam,
@@ -96,7 +102,8 @@ instance Record IndexUser where
           serviceId = WithWriteTime <$> service <*> tService,
           managedBy = WithWriteTime <$> managedBy <*> tManagedBy,
           ssoId = WithWriteTime <$> ssoId <*> tSsoId,
-          unverifiedEmail = WithWriteTime <$> emailUnvalidated <*> tEmailUnvalidated
+          unverifiedEmail = WithWriteTime <$> emailUnvalidated <*> tEmailUnvalidated,
+          writeTimeBumper = tWriteTimeBumper
         }
 {- ORMOLU_ENABLE -}
 
@@ -113,7 +120,8 @@ indexUserToVersion IndexUser {..} =
       const () <$$> fmap writetime serviceId,
       const () <$$> fmap writetime managedBy,
       const () <$$> fmap writetime ssoId,
-      const () <$$> fmap writetime unverifiedEmail
+      const () <$$> fmap writetime unverifiedEmail,
+      const () <$$> writeTimeBumper
     ]
 
 indexUserToDoc :: SearchVisibilityInbound -> IndexUser -> UserDoc

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

@@ -547,7 +547,7 @@ syncUserIndex ::
   ) =>
   UserId ->
   Sem r ()
-syncUserIndex uid =
+syncUserIndex uid = do
   getIndexUser uid
     >>= maybe deleteFromIndex upsert
   where

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

@@ -65,7 +65,12 @@ createCodeOverwritePreviousImpl gen scope retries timeout mId = do
   code <- generateVerificationCode gen scope retries timeout mId
   maybe (pure code) (throw . VerificationCodeThrottled) =<< insert code
 
-insert :: (Member VerificationCodeStore r, Member (Input VerificationCodeThrottleTTL) r) => Code -> Sem r (Maybe RetryAfter)
+insert ::
+  ( Member VerificationCodeStore r,
+    Member (Input VerificationCodeThrottleTTL) r
+  ) =>
+  Code ->
+  Sem r (Maybe RetryAfter)
 insert code = do
   VerificationCodeThrottleTTL ttl <- input
   mRetryAfter <- lookupThrottle (codeKey code) (codeScope code)

libs/wire-subsystems/test/unit/Wire/MockInterpreters/UserStore.hs

@@ -83,7 +83,8 @@ storedUserToIndexUser storedUser =
           serviceId = withDefaultTime <$> storedUser.serviceId,
           managedBy = withDefaultTime <$> storedUser.managedBy,
           ssoId = withDefaultTime <$> storedUser.ssoId,
-          unverifiedEmail = Nothing
+          unverifiedEmail = Nothing,
+          writeTimeBumper = Nothing
         }
 
 lookupLocaleImpl :: (Member (State [StoredUser]) r) => UserId -> Sem r (Maybe ((Maybe Language, Maybe Country)))

services/brig/brig.cabal

@@ -183,6 +183,7 @@ library
     Brig.Schema.V83_AddTextStatus
     Brig.Schema.V84_DropTeamInvitationPhone
     Brig.Schema.V85_DropUserKeysHashed
+    Brig.Schema.V86_WriteTimeBumper
     Brig.Team.API
     Brig.Team.Email
     Brig.Team.Template

services/brig/brig.integration.yaml

@@ -155,9 +155,9 @@ turn:
   tokenTTL: 21600
 
 optSettings:
-  setActivationTimeout: 10
-  setVerificationTimeout: 10
-  setTeamInvitationTimeout: 10
+  setActivationTimeout: 4
+  setVerificationTimeout: 4
+  setTeamInvitationTimeout: 4
   setExpiredUserCleanupTimeout: 1
   # setStomp: test/resources/stomp-credentials.yaml
   setUserMaxConnections: 16
@@ -171,7 +171,7 @@ optSettings:
     timeout: 5  # seconds.  if you reach the limit, how long do you have to wait to try again.
     retryLimit: 5  # how many times can you have a failed login in that timeframe.
   setSuspendInactiveUsers:  # if this is omitted: never suspend inactive users.
-    suspendTimeout: 10
+    suspendTimeout: 4
   setRichInfoLimit: 5000  # should be in sync with Spar
   setDefaultUserLocale: en
   setMaxTeamSize: 32

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

@@ -26,7 +26,6 @@ import Brig.Data.User qualified as User
 import Brig.Options
 import Brig.User.Auth qualified as Auth
 import Brig.ZAuth hiding (Env, settings)
-import Control.Lens (view)
 import Control.Monad.Trans.Except
 import Data.CommaSeparatedList
 import Data.Id
@@ -226,14 +225,14 @@ mkUserTokenCookie ::
   Cookie (Token u) ->
   m UserTokenCookie
 mkUserTokenCookie c = do
-  s <- view settings
+  s <- asks (.settings)
   pure
     UserTokenCookie
       { utcExpires =
-          guard (cookieType c == PersistentCookie)
-            $> cookieExpires c,
-        utcToken = mkSomeToken (cookieValue c),
-        utcSecure = not (setCookieInsecure s)
+          guard (c.cookieType == PersistentCookie)
+            $> c.cookieExpires,
+        utcToken = mkSomeToken c.cookieValue,
+        utcSecure = not s.cookieInsecure
       }
 
 partitionTokens ::