1
0
Fork 0
mirror of https://code.naskya.net/repos/ndqEd synced 2025-03-20 15:14:54 +09:00

Launch service thread with a function that re-throws if they fail

In Haskell by default if a thread has an exception, the main thread isn't
notified at all. This patch changes service thread launching to re-throw their
exceptions in the main thread, so that their failure is noticed.
This commit is contained in:
fr33domlover 2019-01-14 22:03:49 +00:00
parent 5862b03019
commit adaa920aa4
3 changed files with 39 additions and 4 deletions
src/Vervis

View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
@ -30,7 +30,6 @@ module Vervis.Application
)
where
import Control.Concurrent (forkIO)
import Control.Monad.Logger (liftLoc, runLoggingT, logInfo, logError)
import Database.Persist.Postgresql (createPostgresqlPool, pgConnStr,
pgPoolSize, runSqlPool)
@ -54,6 +53,10 @@ import Yesod.Mail.Send (runMailer)
import qualified Data.Text as T (unpack)
import Control.Concurrent.Local (forkCheck)
import Vervis.ActorKey (generateActorKey, actorKeyRotator)
-- Import all relevant handler modules here.
-- Don't forget to add new modules to your cabal file!
import Vervis.Handler.Common
@ -229,10 +232,10 @@ appMain = do
app <- makeApplication foundation
-- Run SSH server
forkIO $ sshServer foundation
forkCheck $ sshServer foundation
-- Run mailer if SMTP is enabled
forkIO $ mailer foundation
forkCheck $ mailer foundation
-- Run the application with Warp
runSettings (warpSettings foundation) app