Allow unsuspended users to login even if inactive.

There is a way to auto-suspend inactive users after a configurable
time span.  This change makes sure that expired cookies that would
trigger auto-suspend immediately are removed on re-activation.

Author: fisx

libs/wire-subsystems/src/Wire/AuthenticationSubsystem.hs

@@ -78,6 +78,7 @@ data AuthenticationSubsystem m a where
     SameLabelPolicy ->
     AuthenticationSubsystem m (Either RetryAfter (Cookie (ZAuth.Token t)))
   RevokeCookies :: UserId -> [CookieId] -> [CookieLabel] -> AuthenticationSubsystem m ()
+  RevokeAllExpiredCookies :: UserId -> AuthenticationSubsystem m ()
   -- Verification Codes
   EnforceVerificationCodeEither :: Local UserId -> Maybe Code.Value -> VerificationAction -> AuthenticationSubsystem m (Either VerificationCodeError ())
   -- For testing

libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Config.hs

@@ -26,6 +26,7 @@ import Data.Vector qualified as Vector
 import Data.ZAuth.Creation qualified as ZC
 import Imports
 import Sodium.Crypto.Sign
+import Util.Timeout
 import Wire.API.Allowlists (AllowlistEmailDomains)
 import Wire.AuthenticationSubsystem.Cookie.Limit
 
@@ -35,7 +36,8 @@ data AuthenticationSubsystemConfig = AuthenticationSubsystemConfig
     zauthEnv :: ZAuthEnv,
     userCookieRenewAge :: Integer,
     userCookieLimit :: Int,
-    userCookieThrottle :: CookieThrottle
+    userCookieThrottle :: CookieThrottle,
+    suspendInactiveUsers :: Maybe Timeout
   }
 
 data ZAuthSettings = ZAuthSettings

libs/wire-subsystems/src/Wire/AuthenticationSubsystem/Cookie.hs

@@ -19,12 +19,14 @@ module Wire.AuthenticationSubsystem.Cookie where
 
 import Data.Id
 import Data.RetryAfter
+import Data.Time
 import Data.ZAuth.CryptoSign (CryptoSign)
 import Data.ZAuth.Token
 import Imports
 import Polysemy
 import Polysemy.Error
 import Polysemy.Input
+import Util.Timeout
 import Wire.API.User.Auth
 import Wire.API.UserEvent (UserEvent (UserSessionRefreshSuggested))
 import Wire.AuthenticationSubsystem
@@ -142,3 +144,30 @@ revokeCookiesMatchingExcept u mself ids labels = do
         && ( c.cookieId `elem` ids
                || maybe False (`elem` labels) c.cookieLabel
            )
+
+-- Remove stale cookies.  Stale means either (1) cookie is expired, or
+-- (2) cookie creation time is further in the past than
+-- `env.suspendInactiveUsers` allows.
+revokeAllExpiredCookiesImpl ::
+  ( Member SessionStore r,
+    Member (Input AuthenticationSubsystemConfig) r,
+    Member Now r
+  ) =>
+  UserId ->
+  Sem r ()
+revokeAllExpiredCookiesImpl uid = do
+  now :: UTCTime <- Now.get
+  mbSuspendAge <- (.suspendInactiveUsers) <$> input
+
+  let dead :: Cookie () -> Bool
+      dead c = cookieExpired && userInactive
+        where
+          cookieExpired = c.cookieExpires < now
+          userInactive =
+            maybe
+              False
+              (\suspendAge -> c.cookieCreated < addUTCTime (-(timeoutDiff suspendAge)) now)
+              mbSuspendAge
+
+  cc <- filter dead <$> SessionStore.listCookies uid
+  SessionStore.deleteCookies uid cc

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

@@ -107,6 +107,7 @@ interpretAuthenticationSubsystem userSubsystemInterpreter =
         NewCookie uid mcid typ mLabel policy -> newCookieImpl uid mcid typ mLabel policy
         NewCookieLimited uid mcid typ mLabel policy -> runError $ newCookieLimitedImpl uid mcid typ mLabel policy
         RevokeCookies uid ids labels -> revokeCookiesImpl uid ids labels
+        RevokeAllExpiredCookies uid -> revokeAllExpiredCookiesImpl uid
         -- Verification Codes
         EnforceVerificationCodeEither luid mCode action -> runError $ enforceVerificationCodeImpl luid mCode action
         -- Testing

libs/wire-subsystems/test/unit/Wire/MiniBackend.hs

@@ -461,7 +461,8 @@ defaultAuthenticationSubsystemConfig =
       local = defaultLocalDomain,
       userCookieRenewAge = 2,
       userCookieLimit = 5,
-      userCookieThrottle = StdDevThrottle 5 3
+      userCookieThrottle = StdDevThrottle 5 3,
+      suspendInactiveUsers = Nothing
     }
 
 defaultLocalDomain :: Local ()

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

@@ -315,6 +315,7 @@ teamsAPI ::
     Member (Polysemy.Error UserSubsystemError) r,
     Member Events r,
     Member (Input (Local ())) r,
+    Member AuthenticationSubsystem r,
     Member IndexedUserStore r
   ) =>
   ServerT BrigIRoutes.TeamsAPI (Handler r)
@@ -782,7 +783,8 @@ getPasswordResetCode email =
 changeAccountStatusH ::
   ( Member UserSubsystem r,
     Member Events r,
-    Member UserStore r
+    Member UserStore r,
+    Member AuthenticationSubsystem r
   ) =>
   UserId ->
   AccountStatusUpdate ->

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

@@ -120,6 +120,7 @@ import Wire.API.UserEvent
 import Wire.ActivationCodeStore
 import Wire.ActivationCodeStore qualified as ActivationCode
 import Wire.AuthenticationSubsystem (AuthenticationSubsystem, internalLookupPasswordResetCode)
+import Wire.AuthenticationSubsystem qualified as Auth
 import Wire.BackendNotificationQueueAccess
 import Wire.BlockListStore as BlockListStore
 import Wire.ClientStore (ClientStore)
@@ -626,45 +627,60 @@ changeAccountStatus ::
   ( Member (Concurrency 'Unsafe) r,
     Member UserSubsystem r,
     Member Events r,
-    Member UserStore r
+    Member UserStore r,
+    Member AuthenticationSubsystem r
   ) =>
   NonEmpty UserId ->
   AccountStatus ->
   ExceptT AccountStatusError (AppT r) ()
 changeAccountStatus usrs status = do
-  -- It is safe to not revoke any cookies here; if no valid access
-  -- token is available, cookies are only validated when calling `POST
-  -- /access`, and access token refresh only works on unsuspended
-  -- users.
-  --
-  -- Evidence: `git grep -Hn --color=never 'UserToken\b' | grep libs/wire-api/src/Wire/API/Routes/Public/`.
   ev <- mkUserEvent status
-  lift $ liftSem $ unsafePooledMapConcurrentlyN_ 16 (update ev) usrs
-  where
-    update ::
-      (UserId -> UserEvent) ->
-      UserId ->
-      Sem r ()
-    update ev u = do
-      UserStore.updateAccountStatus u status
-      User.internalUpdateSearchIndex u
-      Events.generateUserEvent u Nothing (ev u)
+  lift $ liftSem $ unsafePooledMapConcurrentlyN_ 16 (changeSingleAccountStatusInternal status ev) usrs
 
 changeSingleAccountStatus ::
   ( Member UserSubsystem r,
     Member Events r,
-    Member UserStore r
+    Member UserStore r,
+    Member AuthenticationSubsystem r
   ) =>
   UserId ->
   AccountStatus ->
   ExceptT AccountStatusError (AppT r) ()
 changeSingleAccountStatus uid status = do
   unlessM (lift . liftSem $ UserStore.doesUserExist uid) $ throwE AccountNotFound
   ev <- mkUserEvent status
-  lift . liftSem $ do
-    UserStore.updateAccountStatus uid status
-    User.internalUpdateSearchIndex uid
-    Events.generateUserEvent uid Nothing (ev uid)
+  lift . liftSem $ changeSingleAccountStatusInternal status ev uid
+
+changeSingleAccountStatusInternal ::
+  ( Member UserSubsystem r,
+    Member Events r,
+    Member UserStore r,
+    Member AuthenticationSubsystem r
+  ) =>
+  AccountStatus ->
+  (UserId -> UserEvent) ->
+  UserId ->
+  Sem r ()
+changeSingleAccountStatusInternal status ev u = do
+  -- It is safe to *not* revoke any cookies here; if no valid access
+  -- token is available, cookies are only validated when calling `POST
+  -- /access`, and access token refresh only works on unsuspended
+  -- users.
+  --
+  -- Evidence: `git grep -Hn --color=never 'UserToken\b' | grep libs/wire-api/src/Wire/API/Routes/Public/`.
+  --
+  -- Having that said, we need to remove all *expired* cookies here,
+  -- otherwise /login considers the user inactive, see
+  -- 'mustSuspendInactiveUser'.
+  --
+  -- The intuition is that every change of account status can be
+  -- considered an account activity, so users that have their status
+  -- changed recently should not be considered inactive, even if they
+  -- haven't taken any action themselves.
+  Auth.revokeAllExpiredCookies u
+  UserStore.updateAccountStatus u status
+  User.internalUpdateSearchIndex u
+  Events.generateUserEvent u Nothing (ev u)
 
 mkUserEvent ::
   (Monad m) =>

services/brig/src/Brig/CanonicalInterpreter.hs

@@ -28,7 +28,7 @@ import Brig.Effects.SFT (SFT, interpretSFT)
 import Brig.Effects.UserPendingActivationStore (UserPendingActivationStore)
 import Brig.Effects.UserPendingActivationStore.Cassandra (userPendingActivationStoreToCassandra)
 import Brig.IO.Intra (runEvents)
-import Brig.Options (Settings (consumableNotifications), federationDomainConfigs, federationStrategy)
+import Brig.Options (Settings (consumableNotifications), SuspendInactiveUsers (..), federationDomainConfigs, federationStrategy)
 import Brig.Options qualified as Opt
 import Brig.Template (InvitationUrlTemplates)
 import Brig.User.Search.Index (IndexEnv (..))
@@ -352,7 +352,8 @@ runBrigToIO e (AppT ma) = do
             local = localUnit,
             userCookieRenewAge = e.settings.userCookieRenewAge,
             userCookieLimit = e.settings.userCookieLimit,
-            userCookieThrottle = e.settings.userCookieThrottle
+            userCookieThrottle = e.settings.userCookieThrottle,
+            suspendInactiveUsers = suspendTimeout <$> e.settings.suspendInactiveUsers
           }
       mainESEnv = e.indexEnv ^. to idxElastic
       indexedUserStoreConfig =

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

@@ -69,6 +69,7 @@ import Wire.API.Team.Member qualified as Teams
 import Wire.API.Team.Permission (Perm (AddTeamMember))
 import Wire.API.Team.Size
 import Wire.API.User hiding (fromEmail)
+import Wire.AuthenticationSubsystem qualified as Auth
 import Wire.BlockListStore
 import Wire.EmailSubsystem.Interpreter (renderInvitationUrl)
 import Wire.Error
@@ -372,6 +373,7 @@ suspendTeam ::
     Member Events r,
     Member TinyLog r,
     Member InvitationStore r,
+    Member Auth.AuthenticationSubsystem r,
     Member UserStore r
   ) =>
   TeamId ->
@@ -392,6 +394,7 @@ unsuspendTeam ::
     Member UserSubsystem r,
     Member TeamSubsystem r,
     Member Events r,
+    Member Auth.AuthenticationSubsystem r,
     Member UserStore r
   ) =>
   TeamId ->
@@ -410,6 +413,7 @@ changeTeamAccountStatuses ::
     Member TeamSubsystem r,
     Member UserSubsystem r,
     Member Events r,
+    Member Auth.AuthenticationSubsystem r,
     Member UserStore r
   ) =>
   TeamId ->

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

@@ -235,7 +235,8 @@ catchSuspendInactiveUser ::
   ( Member TinyLog r,
     Member UserSubsystem r,
     Member Events r,
-    Member UserStore r
+    Member UserStore r,
+    Member AuthenticationSubsystem r
   ) =>
   UserId ->
   e ->