fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: restore behaviour of waiting asynchronously for job-management

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-25 18:51:54 +02:00
parent cc7a5289a4
commit 5ebcd89e11
1 changed files with 3 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Jobs.hs
View File

@ -55,6 +55,8 @@ import Data.Time.Zones
import Control.Concurrent.STM (retry) import Control.Concurrent.STM (retry)
import Control.Concurrent.STM.Delay import Control.Concurrent.STM.Delay
import UnliftIO.Concurrent (forkIO)
import Jobs.Handler.SendNotification import Jobs.Handler.SendNotification
import Jobs.Handler.SendTestEmail import Jobs.Handler.SendTestEmail
@ -219,7 +221,7 @@ stopJobCtl UniWorX{appJobState} = do
didStop <- atomically $ do didStop <- atomically $ do
jState <- tryReadTMVar appJobState jState <- tryReadTMVar appJobState
for jState $ \jSt'@JobState{jobShutdown} -> jSt' <$ tryPutTMVar jobShutdown () for jState $ \jSt'@JobState{jobShutdown} -> jSt' <$ tryPutTMVar jobShutdown ()
whenIsJust didStop $ \jSt' -> void . atomically $ do whenIsJust didStop $ \jSt' -> void . forkIO . atomically $ do
workers <- maybe [] (Map.keys . jobWorkers) <$> tryTakeTMVar appJobState workers <- maybe [] (Map.keys . jobWorkers) <$> tryTakeTMVar appJobState
mapM_ (void . waitCatchSTM) $ mapM_ (void . waitCatchSTM) $
[ jobPoolManager jSt' [ jobPoolManager jSt'