diff --git a/src/Application.hs b/src/Application.hs index d6f72c080..65bdf4ea1 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -98,6 +98,8 @@ import qualified Web.ServerSession.Backend.Acid as Acid import qualified Ldap.Client as Ldap (Host(Plain, Tls)) import qualified Network.Minio as Minio + +import Web.ServerSession.Core (StorageException(..)) -- Import all relevant handler modules here. -- (HPack takes care to add new modules to our cabal file nowadays.) @@ -433,7 +435,7 @@ warpSettings foundation = defaultSettings & setHost (foundation ^. _appHost) & setPort (foundation ^. _appPort) & setOnException (\_req e -> - when (defaultShouldDisplayException e) $ do + when (shouldDisplayException e) $ do logger <- readTVarIO . snd $ appLogger foundation messageLoggerSource foundation @@ -443,6 +445,16 @@ warpSettings foundation = defaultSettings LevelError (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