fix: suppress exceptions relating to expired sessions

This commit is contained in:
Gregor Kleen 2020-07-29 09:46:38 +02:00
parent c0b79274d8
commit d47d6aa6cc

View File

@ -98,6 +98,8 @@ import qualified Web.ServerSession.Backend.Acid as Acid
import qualified Ldap.Client as Ldap (Host(Plain, Tls)) import qualified Ldap.Client as Ldap (Host(Plain, Tls))
import qualified Network.Minio as Minio import qualified Network.Minio as Minio
import Web.ServerSession.Core (StorageException(..))
-- Import all relevant handler modules here. -- Import all relevant handler modules here.
-- (HPack takes care to add new modules to our cabal file nowadays.) -- (HPack takes care to add new modules to our cabal file nowadays.)
@ -433,7 +435,7 @@ warpSettings foundation = defaultSettings
& setHost (foundation ^. _appHost) & setHost (foundation ^. _appHost)
& setPort (foundation ^. _appPort) & setPort (foundation ^. _appPort)
& setOnException (\_req e -> & setOnException (\_req e ->
when (defaultShouldDisplayException e) $ do when (shouldDisplayException e) $ do
logger <- readTVarIO . snd $ appLogger foundation logger <- readTVarIO . snd $ appLogger foundation
messageLoggerSource messageLoggerSource
foundation foundation
@ -443,6 +445,16 @@ warpSettings foundation = defaultSettings
LevelError LevelError
(toLogStr $ "Exception from Warp: " ++ show e) (toLogStr $ "Exception from Warp: " ++ show e)
) )
where
shouldDisplayException e = and
[ defaultShouldDisplayException e
, case fromException e of
Just (SessionDoesNotExist{} :: StorageException (MemcachedSqlStorage SessionMap)) -> False
_other -> True
, case fromException e of
Just (SessionDoesNotExist{} :: StorageException (AcidStorage SessionMap)) -> False
_other -> True
]
getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings getAppDevSettings, getAppSettings :: MonadIO m => m AppSettings