Suspend inactive users (#831)

* Helper function for suspending accounts.

* Cleanup module export.

* Suspend inactive users (config file option).

services/brig/brig.integration.yaml

@@ -140,6 +140,8 @@ optSettings:
   setLimitFailedLogins:
     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:  # this this is omitted: never suspend inactive users.
+    suspendTimeout: 10
   setRichInfoLimit: 5000  # should be in sync with Spar
   setDefaultLocale: en
   setMaxTeamSize: 32

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

@@ -12,6 +12,7 @@ module Brig.API.User
     , lookupHandle
     , changeManagedBy
     , changeAccountStatus
+    , suspendAccount
     , Data.lookupAccounts
     , Data.lookupAccount
     , Data.lookupStatus
@@ -466,6 +467,12 @@ changeAccountStatus usrs status = do
         Data.updateStatus u status
         Intra.onUserEvent u Nothing (ev u)
 
+suspendAccount :: HasCallStack => List1 UserId -> AppIO ()
+suspendAccount usrs = runExceptT (changeAccountStatus usrs Suspended) >>= \case
+    Right _ -> pure ()
+    Left InvalidAccountStatus -> error "impossible."
+
+
 -------------------------------------------------------------------------------
 -- Activation
 

services/brig/src/Brig/Options.hs

@@ -180,6 +180,12 @@ data LimitFailedLogins = LimitFailedLogins
 
 instance FromJSON LimitFailedLogins
 
+data SuspendInactiveUsers = SuspendInactiveUsers
+    { suspendTimeout :: !Timeout
+    } deriving (Eq, Show, Generic)
+
+instance FromJSON SuspendInactiveUsers
+
 -- | ZAuth options
 data ZAuthOpts = ZAuthOpts
     { privateKeys  :: !FilePath        -- ^ Private key file
@@ -288,6 +294,9 @@ data Settings = Settings
     , setLimitFailedLogins     :: !(Maybe LimitFailedLogins) -- ^ Block user from logging in
                                                              -- for m minutes after n failed
                                                              -- logins
+    , setSuspendInactiveUsers  :: !(Maybe SuspendInactiveUsers)
+                                               -- ^ If last cookie renewal is too long ago,
+                                               -- suspend the user.
     , setRichInfoLimit         :: !Int     -- ^ Max size of rich info (number of chars in
                                            --   field names and values), should be in sync
                                            --   with Spar

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

@@ -20,6 +20,7 @@ import Imports
 import Control.Lens (view, to)
 import Brig.App
 import Brig.API.Types
+import Brig.API.User (suspendAccount)
 import Brig.Budget
 import Brig.Email
 import Brig.Data.UserKey
@@ -31,16 +32,21 @@ import Brig.Types.Common
 import Brig.Types.Intra
 import Brig.Types.User
 import Brig.Types.User.Auth hiding (user)
-import Control.Error
+import Control.Error hiding (bool)
 import Data.Id
+import Data.ByteString.Conversion (toByteString)
+import Data.List1 (singleton)
 import Data.Misc (PlainTextPassword (..))
+import System.Logger (msg, field, (~~), val)
 
 import qualified Brig.Data.Activation as Data
 import qualified Brig.Data.LoginCode as Data
 import qualified Brig.Data.User as Data
 import qualified Brig.Data.UserKey as Data
 import qualified Brig.Options as Opt
 import qualified Brig.ZAuth as ZAuth
+import qualified System.Logger.Class as Log
+
 
 data Access = Access
     { accessToken  :: !AccessToken
@@ -125,7 +131,8 @@ renewAccess
     -> Maybe ZAuth.AccessToken
     -> ExceptT ZAuth.Failure AppIO Access
 renewAccess ut at = do
-    (_, ck) <- validateTokens ut at
+    (uid, ck) <- validateTokens ut at
+    catchSuspendInactiveUser uid ZAuth.Expired
     ck' <- lift $ nextCookie ck
     at' <- lift $ newAccessToken (fromMaybe ck ck') at
     return $ Access at' ck'
@@ -143,8 +150,19 @@ revokeAccess u pw cc ll = do
 --------------------------------------------------------------------------------
 -- Internal
 
+catchSuspendInactiveUser :: UserId -> e -> ExceptT e AppIO ()
+catchSuspendInactiveUser uid errval = do
+  mustsuspend <- lift $ mustSuspendInactiveUser uid
+  Log.warn $ msg (val "catchSuspendInactiveUser")
+    ~~ field "user" (toByteString uid)
+    ~~ field "mustsuspend" mustsuspend
+  when mustsuspend $ do
+    lift $ suspendAccount (singleton uid)
+    throwE errval
+
 newAccess :: UserId -> CookieType -> Maybe CookieLabel -> ExceptT LoginError AppIO Access
 newAccess u ct cl = do
+    catchSuspendInactiveUser u LoginSuspended
     r <- lift $ newCookieLimited u ct cl
     case r of
         Left delay -> throwE $ LoginThrottled delay

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

@@ -3,11 +3,11 @@ module Brig.User.Auth.Cookie
       newCookie
     , newAccessToken
     , nextCookie
-    , renewCookie
     , lookupCookie
     , revokeCookies
     , revokeAllCookies
     , listCookies
+    , mustSuspendInactiveUser
 
       -- * Limited Cookies
     , RetryAfter (..)
@@ -27,7 +27,7 @@ import Brig.App
 import Brig.Options hiding (user)
 import Brig.Types.User.Auth hiding (user)
 import Brig.User.Auth.Cookie.Limit
-import Control.Lens (view)
+import Control.Lens (view, to)
 import Data.ByteString.Conversion
 import Data.Id
 import Data.Text.Encoding (encodeUtf8)
@@ -110,6 +110,30 @@ renewCookie old = do
     DB.insertCookie u old' (Just (DB.TTL (fromIntegral ttl)))
     return new
 
+-- | Whether a user has not renewed any of her cookies for longer than
+-- 'suspendCookiesOlderThanSecs'.  Call this always before 'newCookie', 'nextCookie',
+-- 'newCookieLimited' if there is a chance that the user should be suspended (we don't do it
+-- implicitly because of cyclical dependencies).
+mustSuspendInactiveUser :: UserId -> AppIO Bool
+mustSuspendInactiveUser uid = view (settings . to setSuspendInactiveUsers) >>= \case
+    Nothing -> pure False
+    Just (SuspendInactiveUsers (Timeout suspendAge)) -> do
+        now <- liftIO =<< view currentTime
+
+        let suspendHere :: UTCTime
+            suspendHere = addUTCTime (-suspendAge) now
+
+            youngEnough :: Cookie () -> Bool
+            youngEnough = (>= suspendHere) . cookieCreated
+
+        ckies <- listCookies uid []
+        let mustSuspend
+              | null ckies            = False
+              | any youngEnough ckies = False
+              | otherwise             = True
+
+        pure mustSuspend
+
 newAccessToken :: Cookie ZAuth.UserToken -> Maybe ZAuth.AccessToken -> AppIO AccessToken
 newAccessToken c mt = do
     t' <- case mt of

services/brig/test/integration/API/User/Auth.hs

@@ -11,6 +11,7 @@ import Brig.Types.User.Auth
 import Brig.ZAuth (ZAuth, runZAuth)
 import UnliftIO.Async hiding (wait)
 import Control.Lens ((^?), set)
+import Control.Retry
 import Data.Aeson
 import Data.Aeson.Lens
 import Data.ByteString.Conversion
@@ -33,9 +34,10 @@ import qualified Data.Text.Lazy       as Lazy
 import qualified Brig.ZAuth           as ZAuth
 import qualified Data.Text            as Text
 import qualified Data.UUID.V4         as UUID
-
+import qualified Test.Tasty.HUnit     as HUnit
 import qualified Network.Wai.Utilities.Error as Error
 
+
 tests :: Maybe Opts.Opts -> Manager -> ZAuth.Env -> Brig -> TestTree
 tests conf m z b = testGroup "auth"
         [ testGroup "login"
@@ -60,6 +62,7 @@ tests conf m z b = testGroup "auth"
             , test m "unknown-cookie" (testUnknownCookie z b)
             , test m "new-persistent-cookie" (testNewPersistentCookie conf b)
             , test m "new-session-cookie" (testNewSessionCookie conf b)
+            , test m "suspend-inactive" (testSuspendInactiveUsers conf b)
             ]
         , testGroup "cookies"
             [ test m "list" (testListCookies b)
@@ -439,6 +442,57 @@ testNewSessionCookie config b = do
         const 200     === statusCode
         const Nothing === getHeader "Set-Cookie"
 
+testSuspendInactiveUsers :: HasCallStack => Maybe Opts.Opts -> Brig -> Http ()
+testSuspendInactiveUsers (Just config) brig = do
+    -- (context information: cookies are stored by user, not be device; so if there if the
+    -- cookie is old it means none of the devices of a user has used it for a request.)
+
+    let Just suspendAge = Opts.suspendTimeout <$> Opts.setSuspendInactiveUsers (Opts.optSettings config)
+    unless (suspendAge <= 30) $
+        error "`suspendCookiesOlderThanSecs` is the number of seconds this test is running.  Please pick a value < 30."
+
+    let check :: HasCallStack => CookieType -> String -> Http ()
+        check cookieType endPoint = do
+            user <- randomUser brig
+            let Just email = userEmail user
+            rs <- login brig (emailLogin email defPassword Nothing) cookieType
+                <!! const 200 === statusCode
+            let cky = decodeCookie rs
+
+            -- wait slightly longer than required for being marked as inactive.
+            let waitTime :: Int = floor (Opts.timeoutDiff suspendAge) + 5  -- adding 1 *should* be enough, but it's not.
+            liftIO $ threadDelay (1000000 * waitTime)
+
+            case endPoint of
+                "/access" -> do
+                    post (brig . path "/access" . cookie cky) !!! do
+                        const 403     === statusCode
+                        const Nothing === getHeader "Set-Cookie"
+                "/login" -> do
+                    login brig (emailLogin email defPassword Nothing) cookieType !!! do
+                        const 403 === statusCode
+                        const Nothing === getHeader "Set-Cookie"
+
+            let assertStatus want = do
+                  have <- retrying (exponentialBackoff 200000 <> limitRetries 6)
+                    (\_ have -> pure $ have == Suspended)
+                    (\_ -> getStatus brig (userId user))
+                  let errmsg = "testSuspendInactiveUsers: " <> show (want, cookieType, endPoint, waitTime, suspendAge)
+                  liftIO $ HUnit.assertEqual errmsg want have
+
+            assertStatus Suspended
+            setStatus brig (userId user) Active
+            assertStatus Active
+
+            login brig (emailLogin email defPassword Nothing) cookieType
+                !!! const 200 === statusCode
+
+    check SessionCookie "/access"
+    check SessionCookie "/login"
+    check PersistentCookie "/access"
+    check PersistentCookie "/login"
+
+
 -------------------------------------------------------------------------------
 -- Cookie Management
 
@@ -538,6 +592,9 @@ testTooManyCookies config b = do
                 let Just n = fromByteString =<< getHeader "Retry-After" x
                 liftIO $ threadDelay (1000000 * (n + 1))
                 loginWhenAllowed pwl t
+            403 -> error ("forbidden; " <>
+                          "perhaps setSuspendInactiveUsers.suspendTimeout is too small? " <>
+                          "(try 29 seconds).")
             xxx -> error ("Unexpected status code when logging in: " ++ show xxx)
 
 testLogout :: Brig -> Http ()