fix: suppress exceptions relating to expired sessions
This commit is contained in:
parent
c0b79274d8
commit
d47d6aa6cc
@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user