Keep track of user inactivity in postgres and without cookies.

Author: fisx

libs/wire-subsystems/postgres-migrations/20260519120000-create-last-user-activity.sql

@@ -0,0 +1,4 @@
+CREATE TABLE last_user_activity (
+    user_id   uuid        PRIMARY KEY,
+    active_at timestamptz NOT NULL
+);

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

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

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

@@ -21,6 +21,7 @@ import Data.Aeson
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Qualified
+import Data.Time.Clock (NominalDiffTime)
 import Data.Vector (Vector)
 import Data.Vector qualified as Vector
 import Data.ZAuth.Creation qualified as ZC
@@ -35,7 +36,8 @@ data AuthenticationSubsystemConfig = AuthenticationSubsystemConfig
     zauthEnv :: ZAuthEnv,
     userCookieRenewAge :: Integer,
     userCookieLimit :: Int,
-    userCookieThrottle :: CookieThrottle
+    userCookieThrottle :: CookieThrottle,
+    suspendInactiveUsersTimeout :: Maybe NominalDiffTime
   }
 
 data ZAuthSettings = ZAuthSettings

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

@@ -42,6 +42,7 @@ import Wire.API.Allowlists qualified as AllowLists
 import Wire.API.Team.Feature
 import Wire.API.User
 import Wire.API.User.Password
+import Wire.API.UserEvent (UserEvent (UserSuspended))
 import Wire.AuthenticationSubsystem
 import Wire.AuthenticationSubsystem.Config
 import Wire.AuthenticationSubsystem.Cookie
@@ -59,6 +60,8 @@ import Wire.Sem.Now
 import Wire.Sem.Now qualified as Now
 import Wire.Sem.Random (Random)
 import Wire.SessionStore
+import Wire.UserActivityStore (UserActivityStore)
+import Wire.UserActivityStore qualified as UserActivityStore
 import Wire.UserKeyStore
 import Wire.UserStore (UserStore)
 import Wire.UserStore qualified as UserStore
@@ -81,6 +84,7 @@ interpretAuthenticationSubsystem ::
     Member PasswordStore r,
     Member EmailSubsystem r,
     Member UserStore r,
+    Member UserActivityStore r,
     Member RateLimit r,
     Member CryptoSign r,
     Member Random r,
@@ -107,6 +111,9 @@ 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
+        -- Inactivity tracking
+        RecordUserActivity uid -> recordUserActivityImpl uid
+        CheckAndSuspendInactiveUser uid er -> checkAndSuspendInactiveUserImpl uid er
         -- Verification Codes
         EnforceVerificationCodeEither luid mCode action -> runError $ enforceVerificationCodeImpl luid mCode action
         -- Testing
@@ -415,6 +422,48 @@ verifyUserPasswordErrorImpl (tUnqualified -> uid) password = do
   unlessM (fst <$> verifyUserPasswordImpl uid password) do
     throw AuthenticationSubsystemBadCredentials
 
+recordUserActivityImpl ::
+  ( Member Now r,
+    Member UserActivityStore r
+  ) =>
+  UserId ->
+  Sem r ()
+recordUserActivityImpl uid = do
+  now <- Now.get
+  UserActivityStore.updateLastActivity uid now
+
+checkAndSuspendInactiveUserImpl ::
+  ( Member (Input AuthenticationSubsystemConfig) r,
+    Member UserActivityStore r,
+    Member Now r,
+    Member UserStore r,
+    Member UserSubsystem r,
+    Member Events r,
+    Member TinyLog r
+  ) =>
+  UserId ->
+  e ->
+  Sem r (Either e ())
+checkAndSuspendInactiveUserImpl uid er =
+  inputs (.suspendInactiveUsersTimeout) >>= \case
+    Nothing -> pure (Right ())
+    Just timeout -> do
+      UserActivityStore.getLastActivity uid >>= \case
+        Nothing -> pure (Right ())
+        Just lastActivity -> do
+          now <- Now.get
+          if diffUTCTime now lastActivity > timeout
+            then do
+              Log.warn $
+                msg (val "Suspending user due to inactivity")
+                  . field "user" (toByteString uid)
+                  . field "action" ("user.suspend" :: String)
+              UserStore.updateAccountStatus uid Suspended
+              User.internalUpdateSearchIndex uid
+              generateUserEvent uid Nothing (UserSuspended uid)
+              pure (Left er)
+            else pure (Right ())
+
 enforceVerificationCodeImpl ::
   forall r.
   ( Member GalleyAPIAccess r,

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

@@ -0,0 +1,32 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2026 Wire Swiss GmbH <opensource@wire.com>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+module Wire.UserActivityStore where
+
+import Data.Id
+import Data.Time.Clock
+import Imports
+import Polysemy
+
+data UserActivityStore m a where
+  GetLastActivity :: UserId -> UserActivityStore m (Maybe UTCTime)
+  UpdateLastActivity :: UserId -> UTCTime -> UserActivityStore m ()
+  DeleteLastActivity :: UserId -> UserActivityStore m ()
+
+makeSem ''UserActivityStore

libs/wire-subsystems/src/Wire/UserActivityStore/Postgres.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2026 Wire Swiss GmbH <opensource@wire.com>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+module Wire.UserActivityStore.Postgres
+  ( interpretUserActivityStoreToPostgres,
+  )
+where
+
+import Data.Id
+import Data.Time.Clock
+import Hasql.TH
+import Imports
+import Polysemy
+import Wire.Postgres
+import Wire.UserActivityStore
+
+interpretUserActivityStoreToPostgres ::
+  (PGConstraints r) =>
+  InterpreterFor UserActivityStore r
+interpretUserActivityStoreToPostgres = interpret $ \case
+  GetLastActivity uid -> getLastActivityImpl uid
+  UpdateLastActivity uid t -> updateLastActivityImpl uid t
+  DeleteLastActivity uid -> deleteLastActivityImpl uid
+
+getLastActivityImpl :: (PGConstraints r) => UserId -> Sem r (Maybe UTCTime)
+getLastActivityImpl uid =
+  runStatement (toUUID uid) $
+    [maybeStatement|
+      SELECT active_at :: timestamptz
+      FROM last_user_activity
+      WHERE user_id = $1 :: uuid
+    |]
+
+updateLastActivityImpl :: (PGConstraints r) => UserId -> UTCTime -> Sem r ()
+updateLastActivityImpl uid t =
+  runStatement (toUUID uid, t) $
+    [resultlessStatement|
+      INSERT INTO last_user_activity (user_id, active_at)
+      VALUES ($1 :: uuid, $2 :: timestamptz)
+      ON CONFLICT (user_id) DO UPDATE SET active_at = EXCLUDED.active_at
+    |]
+
+deleteLastActivityImpl :: (PGConstraints r) => UserId -> Sem r ()
+deleteLastActivityImpl uid =
+  runStatement (toUUID uid) $
+    [resultlessStatement|
+      DELETE FROM last_user_activity WHERE user_id = $1 :: uuid
+    |]

libs/wire-subsystems/test/unit/Wire/AuthenticationSubsystem/InterpreterSpec.hs

@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-ambiguous-fields #-}
 
 -- This file is part of the Wire Server implementation.
 --
@@ -67,8 +67,10 @@ import Wire.Sem.Now (Now)
 import Wire.Sem.Random (Random)
 import Wire.SessionStore
 import Wire.StoredUser
+import Wire.UserActivityStore (UserActivityStore)
 import Wire.UserKeyStore
 import Wire.UserStore
+import Wire.UserStore qualified as UserStore
 import Wire.VerificationCode
 import Wire.VerificationCodeGen
 import Wire.VerificationCodeStore
@@ -99,38 +101,44 @@ type AllEffects =
     TinyLog,
     EmailSubsystem,
     UserStore,
+    UserActivityStore,
+    State (Map UserId UTCTime),
     UserKeyStore,
     State [MiniEvent],
     State (Map EmailAddress [SentMail]),
     State [StoredApp]
   ]
 
 runAllEffects :: Domain -> [StoredUser] -> Map UserId Password -> Maybe [Text] -> Sem AllEffects a -> Either AuthenticationSubsystemError a
-runAllEffects domain users passwords emailDomains action = snd $ runAllEffectsWithEventStateAndFeatures domain users passwords emailDomains def action
+runAllEffects domain users passwords emailDomains action = snd $ runAllEffectsWithEventStateAndFeatures domain users passwords emailDomains def Nothing action
 
 runAllEffectsWithEventState :: Domain -> [StoredUser] -> Map UserId Password -> Maybe [Text] -> Sem AllEffects a -> ([MiniEvent], Either AuthenticationSubsystemError a)
 runAllEffectsWithEventState localDomain preexistingUsers preexistingPasswords mAllowedEmailDomains =
-  runAllEffectsWithEventStateAndFeatures localDomain preexistingUsers preexistingPasswords mAllowedEmailDomains def
+  runAllEffectsWithEventStateAndFeatures localDomain preexistingUsers preexistingPasswords mAllowedEmailDomains def Nothing
 
 runAllEffectsWithEventStateAndFeatures ::
   Domain ->
   [StoredUser] ->
   Map UserId Password ->
   Maybe [Text] ->
   AllTeamFeatures ->
+  Maybe NominalDiffTime ->
   Sem AllEffects a ->
   ([MiniEvent], Either AuthenticationSubsystemError a)
-runAllEffectsWithEventStateAndFeatures localDomain preexistingUsers preexistingPasswords mAllowedEmailDomains galleyFeatures =
+runAllEffectsWithEventStateAndFeatures localDomain preexistingUsers preexistingPasswords mAllowedEmailDomains galleyFeatures mSuspendTimeout =
   let cfg =
         defaultAuthenticationSubsystemConfig
           { allowlistEmailDomains = AllowlistEmailDomains <$> mAllowedEmailDomains,
-            local = toLocalUnsafe localDomain ()
+            local = toLocalUnsafe localDomain (),
+            suspendInactiveUsersTimeout = mSuspendTimeout
           }
    in run
         . evalState mempty
         . evalState mempty
         . runState mempty
         . runInMemoryUserKeyStoreIntepreterWithStoredUsers preexistingUsers
+        . evalState (mempty :: Map UserId UTCTime)
+        . inMemoryUserActivityStoreInterpreter
         . runInMemoryUserStoreInterpreter preexistingUsers preexistingPasswords
         . inMemoryEmailSubsystemInterpreter
         . discardTinyLogs
@@ -566,7 +574,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do
               luid = toLocalUnsafe testDomain user.id
               features = npUpdate @SndFactorPasswordChallengeConfig (LockableFeature status LockStatusUnlocked def) def
               (_, Right result) =
-                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features $ do
+                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features Nothing $ do
                   code <- createCodeOverwritePrevious (mk6DigitVerificationCodeGen email) (scopeFromAction action) 2 300 Nothing
                   enforceVerificationCodeEither luid (Just code.codeValue) action
            in result === Right ()
@@ -577,7 +585,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do
               luid = toLocalUnsafe testDomain user.id
               features = npUpdate @SndFactorPasswordChallengeConfig (LockableFeature status LockStatusUnlocked def) def
               (_, Right result) =
-                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features $ do
+                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features Nothing $ do
                   _ <- createCodeOverwritePrevious (mk6DigitVerificationCodeGen email) (scopeFromAction action) 2 300 Nothing
                   enforceVerificationCodeEither luid (Just wrongCode) action
            in if status == FeatureStatusEnabled
@@ -590,7 +598,7 @@ spec = describe "AuthenticationSubsystem.Interpreter" do
               luid = toLocalUnsafe testDomain user.id
               features = npUpdate @SndFactorPasswordChallengeConfig (LockableFeature status LockStatusUnlocked def) def
               (_, Right result) =
-                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features $ do
+                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features Nothing $ do
                   _ <- createCodeOverwritePrevious (mk6DigitVerificationCodeGen email) (scopeFromAction action) 2 300 Nothing
                   enforceVerificationCodeEither luid Nothing action
            in if status == FeatureStatusEnabled
@@ -603,13 +611,69 @@ spec = describe "AuthenticationSubsystem.Interpreter" do
               luid = toLocalUnsafe testDomain user.id
               features = npUpdate @SndFactorPasswordChallengeConfig (LockableFeature status LockStatusUnlocked def) def
               (_, Right result) =
-                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features $ do
+                runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing features Nothing $ do
                   code <- createCodeOverwritePrevious (mk6DigitVerificationCodeGen email) (scopeFromAction action) 2 300 Nothing
                   enforceVerificationCodeEither luid (Just code.codeValue) action
            in if status == FeatureStatusEnabled
                 then result === Left VerificationCodeNoEmail
                 else result === Right ()
 
+  describe "checkAndSuspendInactiveUser" do
+    let timeout = 3600 :: NominalDiffTime
+
+    prop "suspends user after timeout expires" $ \userNoEmail ->
+      let user = (userNoEmail :: StoredUser) {status = Just Active}
+          uid = user.id
+          Right finalStatus =
+            snd $ runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing def (Just timeout) $ do
+              recordUserActivity uid
+              passTime (timeout + 1)
+              _ <- checkAndSuspendInactiveUser uid False
+              UserStore.lookupStatus uid
+       in finalStatus === Just Suspended
+
+    prop "returns Left when inactive" $ \userNoEmail ->
+      let user = (userNoEmail :: StoredUser) {status = Just Active}
+          uid = user.id
+          Right result =
+            snd $ runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing def (Just timeout) $ do
+              recordUserActivity uid
+              passTime (timeout + 1)
+              checkAndSuspendInactiveUser uid False
+       in result === Left False
+
+    prop "does not suspend user within timeout" $ \userNoEmail ->
+      let user = (userNoEmail :: StoredUser) {status = Just Active}
+          uid = user.id
+          Right finalStatus =
+            snd $ runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing def (Just timeout) $ do
+              recordUserActivity uid
+              passTime (timeout - 1)
+              _ <- checkAndSuspendInactiveUser uid False
+              UserStore.lookupStatus uid
+       in finalStatus === Just Active
+
+    prop "does not suspend if feature is disabled" $ \userNoEmail ->
+      let user = (userNoEmail :: StoredUser) {status = Just Active}
+          uid = user.id
+          Right finalStatus =
+            snd $ runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing def Nothing $ do
+              recordUserActivity uid
+              passTime (timeout + 1)
+              _ <- checkAndSuspendInactiveUser uid False
+              UserStore.lookupStatus uid
+       in finalStatus === Just Active
+
+    prop "does not suspend if no activity record exists" $ \userNoEmail ->
+      let user = (userNoEmail :: StoredUser) {status = Just Active}
+          uid = user.id
+          Right finalStatus =
+            snd $ runAllEffectsWithEventStateAndFeatures testDomain [user] mempty Nothing def (Just timeout) $ do
+              passTime (timeout + 1)
+              _ <- checkAndSuspendInactiveUser uid False
+              UserStore.lookupStatus uid
+       in finalStatus === Just Active
+
   describe "randomConnId" $ do
     it "generates different connection ids" $ do
       let connIds = run . runRandomPure $ replicateM 100 randomConnId