Cronjobs & notifications for sheet active/inactive

2018-10-13 15:41:02 +02:00 · 2018-10-13 15:41:02 +02:00 · 99c53fee73
commit 99c53fee73
parent 7bdf015560
12 changed files with 266 additions and 138 deletions
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -322,6 +322,12 @@ GermanGermany: Deutsch (Deutschland)
 MailSubjectSubmissionRated csh@CourseShorthand: Ihre #{csh}-Abgabe wurde bewertet
 MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{courseName} (#{termDesc}) wurde bewertet.

+MailSubjectSheetActive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} wurde herausgegeben
+MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können nun #{sheetName} im Kurs #{courseName} (#{termDesc}) herunterladen.
+
+MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden
+MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie können #{sheetName} im Kurs #{courseName} (#{termDesc}) nur noch kurze Zeit abgeben.
+
 SheetTypeBonus: Bonus
 SheetTypeNormal: Normal
 SheetTypePass: Bestehen
--- a/7
+++ b/7
@ -229,4 +229,9 @@ QueuedJob
    creationTime        UTCTime
    lockInstance        InstanceId Maybe
    lockTime            UTCTime Maybe
-    deriving Eq Read Show Generic Typeable
+    deriving Eq Read Show Generic Typeable
+CronLastExec
+    job                 Value
+    time                UTCTime
+    instance            InstanceId
+    UniqueCronLastExec job
--- a/package.yaml
+++ b/package.yaml
@ -102,6 +102,7 @@ dependencies:
 - mime-mail
 - hashable
 - aeson-pretty
+- resourcet

 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.
--- a/src/Application.hs
+++ b/src/Application.hs
@ -5,6 +5,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
    ( getApplicationDev, getAppDevSettings
@ -12,10 +13,10 @@ module Application
    , develMain
    , makeFoundation
    , makeLogWare
-    -- * for DevelMain
-    , foundationStoreNum
-    , getApplicationRepl
-    , shutdownApp
+    -- -- * for DevelMain
+    -- , foundationStoreNum
+    -- , getApplicationRepl
+    -- , shutdownApp
    -- * for GHCI
    , handler
    , db
@ -58,6 +59,8 @@ import Network.HaskellNet.SSL hiding (Settings)
 import Network.HaskellNet.SMTP.SSL as SMTP hiding (Settings)
 import Data.Pool

+import Control.Monad.Trans.Resource
+  
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
 import Handler.Common
@ -83,18 +86,16 @@ mkYesodDispatch "UniWorX" resourcesUniWorX
 -- performs initialization and returns a foundation datatype value. This is also
 -- the place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-makeFoundation :: AppSettings -> IO UniWorX
+makeFoundation :: (MonadResource m, MonadBaseControl IO m) => AppSettings -> m UniWorX
 makeFoundation appSettings@(AppSettings{..}) = do
    -- Some basic initializations: HTTP connection manager, logger, and static
    -- subsite.
    appHttpManager <- newManager
-    appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
-    appStatic <-
-        (if appMutableStatic then staticDevel else static)
-        appStaticDir
+    appLogger <- liftIO $ newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
+    appStatic <- liftIO $ bool static staticDevel appMutableStatic appStaticDir

    appCryptoIDKey <- readKeyFile appCryptoIDKeyFile
-    appInstanceID <- maybe UUID.nextRandom readInstanceIDFile appInstanceIDFile
+    appInstanceID <- liftIO $ maybe UUID.nextRandom readInstanceIDFile appInstanceIDFile

    (appJobCtl, recvChans) <- fmap unzip . atomically . replicateM appJobWorkers $ do
        chan <- newBroadcastTMChan
@ -132,8 +133,8 @@ makeFoundation appSettings@(AppSettings{..}) = do
      -- Return the foundation
      return $ mkFoundation sqlPool smtpPool

-readInstanceIDFile :: FilePath -> IO UUID
-readInstanceIDFile idFile = handle generateInstead $ LBS.readFile idFile >>= parseBS
+readInstanceIDFile :: MonadIO m => FilePath -> m UUID
+readInstanceIDFile idFile = liftIO . handle generateInstead $ LBS.readFile idFile >>= parseBS
  where
    parseBS :: LBS.ByteString -> IO UUID
    parseBS = maybe (throwString "appInstanceIDFile does not contain an UUID encoded in network byte order") return . UUID.fromByteString
@ -174,15 +175,15 @@ createSmtpPool SmtpConf{ smtpPool = ResourcePoolConf{..}, .. } = do

 -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
 -- applying some additional middlewares.
-makeApplication :: UniWorX -> IO Application
-makeApplication foundation = do
+makeApplication :: MonadIO m => UniWorX -> m Application
+makeApplication foundation = liftIO $ do
    logWare <- makeLogWare foundation
    -- Create the WAI application and apply middlewares
    appPlain <- toWaiAppPlain foundation
    return $ logWare $ defaultMiddlewaresNoLogging appPlain

-makeLogWare :: UniWorX -> IO Middleware
-makeLogWare foundation =
+makeLogWare :: MonadIO m => UniWorX -> m Middleware
+makeLogWare foundation = liftIO $
    mkRequestLogger def
        { outputFormat =
            if appDetailedRequestLogging $ appSettings foundation
@ -211,26 +212,29 @@ warpSettings foundation =
      defaultSettings

 -- | For yesod devel, return the Warp settings and WAI Application.
-getApplicationDev :: IO (Settings, Application)
+getApplicationDev :: (MonadResource m, MonadBaseControl IO m) => m (Settings, Application)
 getApplicationDev = do
    settings <- getAppDevSettings
    foundation <- makeFoundation settings
-    wsettings <- getDevSettings $ warpSettings foundation
+    wsettings <- liftIO . getDevSettings $ warpSettings foundation
    app <- makeApplication foundation
    return (wsettings, app)

-getAppDevSettings :: IO AppSettings
-getAppDevSettings = loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv
+getAppDevSettings :: MonadIO m => m AppSettings
+getAppDevSettings = liftIO $ loadYamlSettings [configSettingsYml] [configSettingsYmlValue] useEnv

 -- | main function for use by yesod devel
 develMain :: IO ()
-develMain = develMainHelper getApplicationDev
+develMain = runResourceT $ do
+  app <- getApplicationDev
+  liftIO . develMainHelper $ return app

 -- | The @main@ function for an executable running this site.
-appMain :: IO ()
-appMain = do
+appMain :: MonadResourceBase m => m ()
+appMain = runResourceT $ do
    -- Get the settings from all relevant sources
-    settings <- loadYamlSettingsArgs
+    settings <- liftIO $
+      loadYamlSettingsArgs
        -- fall back to compile-time values, set to [] to require values at runtime
        [configSettingsYmlValue]

@ -244,31 +248,31 @@ appMain = do
    app <- makeApplication foundation

    -- Run the application with Warp
-    runSettings (warpSettings foundation) app
+    liftIO $ runSettings (warpSettings foundation) app


--------------------------------------------------------------
-- Functions for DevelMain.hs (a way to run the app from GHCi)
--------------------------------------------------------------
-foundationStoreNum :: Word32
-foundationStoreNum = 2
+-- --------------------------------------------------------------
+-- -- Functions for DevelMain.hs (a way to run the app from GHCi)
+-- --------------------------------------------------------------
+-- foundationStoreNum :: Word32
+-- foundationStoreNum = 2
  
-getApplicationRepl :: IO (Int, UniWorX, Application)
-getApplicationRepl = do
-    settings <- getAppDevSettings
-    foundation <- makeFoundation settings
-    wsettings <- getDevSettings $ warpSettings foundation
-    app1 <- makeApplication foundation
+-- getApplicationRepl :: IO (Int, UniWorX, Application)
+-- getApplicationRepl = do
+--     settings <- getAppDevSettings
+--     foundation <- makeFoundation settings
+--     wsettings <- getDevSettings $ warpSettings foundation
+--     app1 <- makeApplication foundation

-    let foundationStore = Store foundationStoreNum
-    deleteStore foundationStore
-    writeStore foundationStore foundation
+--     let foundationStore = Store foundationStoreNum
+--     deleteStore foundationStore
+--     writeStore foundationStore foundation
  
-    return (getPort wsettings, foundation, app1)
+--     return (getPort wsettings, foundation, app1)

-shutdownApp :: UniWorX -> IO ()
-shutdownApp UniWorX{..} = do
-  atomically $ mapM_ closeTMChan appJobCtl
+-- shutdownApp :: UniWorX -> IO ()
+-- shutdownApp UniWorX{..} = do
+--   atomically $ mapM_ closeTMChan appJobCtl


 ---------------------------------------------
@ -277,7 +281,7 @@ shutdownApp UniWorX{..} = do

 -- | Run a handler
 handler :: Handler a -> IO a
-handler h = getAppDevSettings >>= makeFoundation >>= flip unsafeHandler h
+handler h = runResourceT $ liftIO getAppDevSettings >>= makeFoundation >>= liftIO . flip unsafeHandler h

 -- | Run DB queries
 db :: ReaderT SqlBackend (HandlerT UniWorX IO) a -> IO a
--- a/src/Cron.hs
+++ b/src/Cron.hs
@ -8,8 +8,7 @@
  #-}

 module Cron
-  ( matchesCron
-  , CronNextMatch(..)
+  ( CronNextMatch(..)
  , nextCronMatch
  , module Cron.Types
  ) where
@ -204,21 +203,3 @@ nextCronMatch tz mPrev now c@Cron{..}
        localDay <- maybeToList $ fromGregorianValid (fromIntegral cronYear) (fromIntegral cronMonth) (fromIntegral cronDayOfMonth)
        let localTimeOfDay = TimeOfDay (fromIntegral cronHour) (fromIntegral cronMinute) (fromIntegral cronSecond)
        return $ localTimeToUTCTZ tz LocalTime{..}
-
-matchesCron :: TZ -- ^ Timezone of the `Cron`-Entry
-            -> Maybe UTCTime -- ^ Previous execution of the job
-            -> NominalDiffTime -- ^ Approximate time until next check
-            -> UTCTime -- ^ "Current" time
-            -> Cron
-            -> Bool
-- ^ @matchesCron tz prev prec now c@ determines whether the given `Cron`
--   specification @c@ should match @now@, under the assumption that the next
--   check will occur no earlier than @now + prec@.
-matchesCron tz mPrev prec now cron@Cron{cronOffset} = case nextCronMatch tz mPrev now cron of
-  MatchAsap -> True
-  MatchNone -> False
-  MatchAt ts -> ts < toT
-  where
-    toT = case cronOffset of
-      CronScheduleBefore -> addUTCTime prec now
-      CronScheduleAfter -> now
--- a/src/Cron/Types.hs
+++ b/src/Cron/Types.hs
@ -5,7 +5,6 @@

 module Cron.Types
  ( Cron(..), Crontab
-  , CronScheduleOffset(..)
  , CronMatch(..)
  , CronAbsolute(..)
  , CronPeriod(..)
@ -23,14 +22,6 @@ import Numeric.Natural
 import Data.HashMap.Strict (HashMap)
  

-- | When the scheduled time for a job falls between two wakeups of the timing
--   thread, execute the job on the wakeup before or after the scheduled time
-data CronScheduleOffset
-  = CronScheduleBefore | CronScheduleAfter
-  deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
-makePrisms ''CronScheduleOffset
-
 data CronMatch
  = CronMatchAny
  | CronMatchNone
@ -67,7 +58,6 @@ makeLenses_ ''CronPeriod
 data Cron = Cron
  { cronInitial :: CronAbsolute
  , cronRepeat :: Maybe CronPeriod
-  , cronOffset :: CronScheduleOffset
  }
  deriving (Eq, Show)

--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@ -13,7 +13,7 @@
  #-}

 module Jobs
-  ( module Jobs.Types
+  ( module Types
  , writeJobCtl
  , queueJob, queueJob'
  , handleJobs
@ -23,7 +23,8 @@ import Import hiding ((.=), Proxy)
 import Handler.Utils.Mail
 import Handler.Utils.DateTime

-import Jobs.Types
+import Jobs.Types as Types hiding (JobCtl(JobCtlQueue))
+import Jobs.Types (JobCtl(JobCtlQueue))

 import Data.Conduit.TMChan
 import qualified Data.Conduit.List as C
@ -32,6 +33,7 @@ import qualified Data.Text.Lazy as LT

 import Data.Aeson (fromJSON, toJSON)
 import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
 import Database.Persist.Sql (executeQQ, fromSqlKey, transactionSave)

 import Data.Monoid (Last(..))
@ -63,6 +65,7 @@ import Control.Monad.Trans.State (StateT, evalStateT, mapStateT)
 import qualified Control.Monad.State.Class as State
 import Control.Monad.Writer.Class (MonadWriter(..))
 import Control.Monad.Reader.Class (MonadReader(..))
+import Control.Monad.Trans.Resource (MonadResourceBase, ResourceT, runResourceT, allocate)

 import Control.Monad.Random (MonadRandom(..), evalRand)

@ -80,24 +83,25 @@ data JobQueueException = JInvalid QueuedJobId QueuedJob
 instance Exception JobQueueException


-handleJobs :: MonadIO m => [TMChan JobCtl] -> UniWorX -> m ()
+handleJobs :: (MonadResource m, MonadIO m) => [TMChan JobCtl] -> UniWorX -> m ()
 -- | Read control commands from `appJobCtl` and address them as they come in
 --
 -- Uses `unsafeHandler`, as per documentation all HTTP-related fields of state/environment are meaningless placeholders.
 -- Handling commands in `HandlerT` provides us with the facilities to render urls, unifies logging, provides a value of the foundation type, ...
-handleJobs recvChans foundation@UniWorX{..} = liftIO $ do
-  jobCrontab <- newTVarIO HashMap.empty
-  jobConfirm <- newTVarIO HashMap.empty
+handleJobs recvChans foundation@UniWorX{..} = do
+  jobCrontab <- liftIO $ newTVarIO HashMap.empty
+  jobConfirm <- liftIO $ newTVarIO HashMap.empty

  forM_ (zip [1..] recvChans) $ \(n, chan) ->
    let
      logStart = $logDebugS ("Jobs #" <> tshow n) "Starting"
      logStop = $logDebugS ("Jobs #" <> tshow n) "Stopping"
-    in void . fork . unsafeHandler foundation . bracket_ logStart logStop . flip runReaderT JobContext{..} . runConduit $ sourceTMChan chan .| handleJobs' n
+      doFork = fork . unsafeHandler foundation . bracket_ logStart logStop . flip runReaderT JobContext{..} . runConduit $ sourceTMChan chan .| handleJobs' n
+    in void $ allocate (liftIO doFork) (liftIO . killThread)

  -- Start cron operation
-  void . fork . unsafeHandler foundation $ runReaderT execCrontab JobContext{..}
-  unsafeHandler foundation . flip runReaderT JobContext{..} $
+  void $ allocate (liftIO . fork . unsafeHandler foundation $ runReaderT execCrontab JobContext{..}) (liftIO . killThread)
+  liftIO . unsafeHandler foundation . flip runReaderT JobContext{..} $
    writeJobCtlBlock JobCtlDetermineCrontab


@ -105,9 +109,18 @@ execCrontab :: ReaderT JobContext (HandlerT UniWorX IO) ()
 -- ^ Keeping a `HashMap` of the latest execution times of `JobCtl`s we have
 --   seen, wait for the time of the next job and fire it
 execCrontab = flip evalStateT HashMap.empty . forever $ do
+  mapStateT (liftHandlerT . runDB . setSerializable) $ do
+    let
+      merge (Entity leId CronLastExec{..})
+        | Just job <- Aeson.parseMaybe parseJSON cronLastExecJob
+        = State.modify $ HashMap.insertWith (<>) (JobCtlQueue job) (Max cronLastExecTime)
+        | otherwise = lift $ delete leId
+    runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ merge
+  
  now <- liftIO getCurrentTime
  (currentCrontab, (jobCtl, nextMatch)) <- mapStateT (mapReaderT $ liftIO . atomically) $ do
    crontab <- liftBase . readTVar =<< asks jobCrontab
+    State.modify . HashMap.filterWithKey $ \k _ -> HashMap.member k crontab
    prevExec <- State.get
    case earliestJob prevExec crontab now of
      Nothing -> liftBase retry
@ -115,9 +128,30 @@ execCrontab = flip evalStateT HashMap.empty . forever $ do
      Just x -> return (crontab, x)

  let doJob = do
-        now <- liftIO $ getCurrentTime
-        State.modify $ HashMap.alter (Just . ($ Max now) . maybe id (<>)) jobCtl
-        writeJobCtl jobCtl
+        mJid <- mapStateT (mapReaderT $ liftHandlerT . runDB . setSerializable) $ do
+          newCrontab <- lift . lift $ determineCrontab
+          if
+            | ((==) `on` HashMap.lookup jobCtl) newCrontab currentCrontab
+              -> do
+                now <- liftIO $ getCurrentTime
+                instanceID <- getsYesod appInstanceID
+                State.modify $ HashMap.alter (Just . ($ Max now) . maybe id (<>)) jobCtl
+                case jobCtl of
+                  JobCtlQueue job -> do
+                    lift . lift $ upsertBy
+                      (UniqueCronLastExec $ toJSON job)
+                      CronLastExec
+                        { cronLastExecJob = toJSON job
+                        , cronLastExecTime = now
+                        , cronLastExecInstance = instanceID
+                        }
+                      [ CronLastExecTime =. now ]
+                    Just <$> lift (lift $ queueJobUnsafe job)
+                  other -> Nothing <$ writeJobCtl other
+            | otherwise
+              -> lift . fmap (const Nothing) . mapReaderT (liftIO . atomically) $
+                   lift . flip writeTVar newCrontab =<< asks jobCrontab
+        maybe (return ()) (writeJobCtl . JobCtlPerform) mJid

  case nextMatch of
    MatchAsap -> doJob
@ -151,48 +185,21 @@ execCrontab = flip evalStateT HashMap.empty . forever $ do
          where
            t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) now cron

-    waitUntil :: (Eq a, MonadIO m) => TVar a -> a -> UTCTime -> m Bool
-    waitUntil crontabTV crontab nextTime = liftIO $ do
-      diffT <- diffUTCTime nextTime <$> getCurrentTime
+    waitUntil :: (Eq a, MonadResourceBase m) => TVar a -> a -> UTCTime -> m Bool
+    waitUntil crontabTV crontab nextTime = runResourceT $ do
+      diffT <- diffUTCTime nextTime <$> liftIO getCurrentTime
      if
        | diffT < acc -> return True
        | otherwise   -> do
-            retVar <- newEmptyTMVarIO
-            delayThread <- forkFinally (threadDelay . floor $ toRational acc * 1e6) (atomically . putTMVar retVar)
+            retVar <- liftIO newEmptyTMVarIO
+            void $ allocate (liftIO $ forkFinally (threadDelay . floor $ toRational acc * 1e6) $ atomically . putTMVar retVar) (liftIO . killThread)
            let
              awaitDelayThread = False <$ takeTMVar retVar
              awaitCrontabChange = do
                crontab' <- readTVar crontabTV
                True <$ guard (crontab /= crontab')
-            crontabChanged <- atomically $ awaitCrontabChange <|> awaitDelayThread
-            bool (waitUntil crontabTV crontab nextTime) (False <$ killThread delayThread) crontabChanged
-
-
-determineCrontab :: Handler (Crontab JobCtl)
-determineCrontab = execWriterT $ do
-  AppSettings{..} <- getsYesod appSettings
-
-  case appJobFlushInterval of
-    Just interval -> tell $ HashMap.singleton
-      JobCtlFlush
-      Cron
-        { cronInitial = CronAsap
-        , cronRepeat = Just CronPeriod
-          { cronMinInterval = interval
-          , cronNext = CronAsap
-          }
-        , cronOffset = CronScheduleBefore
-        }
-    Nothing -> return ()
-
-  now <- liftIO getCurrentTime
-  tell $ HashMap.singleton
-    JobCtlDetermineCrontab
-    Cron
-      { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appJobCronInterval now
-      , cronRepeat = Nothing
-      , cronOffset = CronScheduleBefore
-      }
+            crontabChanged <- liftIO . atomically $ awaitCrontabChange <|> awaitDelayThread
+            bool (waitUntil crontabTV crontab nextTime) (return False) crontabChanged


 handleJobs' :: Int -> Sink JobCtl (ReaderT JobContext Handler) ()
@ -227,10 +234,10 @@ handleJobs' wNum = C.mapM_ $ \jctl -> do

      performJob content

-      -- `performJob` is expected to throw a notification if it detects that the job was not done
+      -- `performJob` is expected to throw an exception if it detects that the job was not done
      runDB $ delete jId
    handleCmd JobCtlDetermineCrontab = do
-      newCTab <- lift determineCrontab
+      newCTab <- liftHandlerT . runDB $ setSerializable determineCrontab
      $logDebugS logIdent $ tshow newCTab
      mapReaderT (liftIO . atomically) $ 
        lift . flip writeTVar newCTab =<< asks jobCrontab
@ -303,20 +310,88 @@ queueJob' job = queueJob job >>= writeJobCtl . JobCtlPerform
 setSerializable :: DB a -> DB a
 setSerializable = ([executeQQ|SET TRANSACTION ISOLATION LEVEL SERIALIZABLE|] *>)

+
+determineCrontab :: DB (Crontab JobCtl)
+-- ^ Extract all future jobs from the database (sheet deadlines, ...)
+determineCrontab = execWriterT $ do
+  AppSettings{..} <- getsYesod appSettings
+
+  case appJobFlushInterval of
+    Just interval -> tell $ HashMap.singleton
+      JobCtlFlush
+      Cron
+        { cronInitial = CronAsap
+        , cronRepeat = Just CronPeriod
+          { cronMinInterval = interval
+          , cronNext = CronAsap
+          }
+        }
+    Nothing -> return ()
+
+  now <- liftIO getCurrentTime
+  tell $ HashMap.singleton
+    JobCtlDetermineCrontab
+    Cron
+      { cronInitial = CronAsap
+      , cronRepeat = Just CronPeriod
+        { cronMinInterval = appJobCronInterval
+        , cronNext = CronAsap
+        }
+      }
+
+  let
+    sheetJobs (Entity nSheet Sheet{..}) = do
+      tell $ HashMap.singleton
+        (JobCtlQueue $ JobQueueNotification NotificationSheetActive{..})
+        Cron
+          { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveFrom
+          , cronRepeat = Nothing
+          }
+      tell $ HashMap.singleton
+        (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
+        Cron
+          { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max sheetActiveFrom $ addUTCTime (-nominalDay) sheetActiveTo
+          , cronRepeat = Nothing
+          }
+      
+  runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs
+
+
+determineNotificationCandidates :: Notification -> DB [Entity User]
+determineNotificationCandidates NotificationSubmissionRated{..} = E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do
+  E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
+  E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
+  return user
+determineNotificationCandidates NotificationSheetActive{..} = E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do
+  E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
+  E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
+  E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
+  return user
+determineNotificationCandidates NotificationSheetInactive{..} = E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> do
+  E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
+  E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
+  E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
+  return user
+
+classifyNotification :: Notification -> DB NotificationTrigger
+classifyNotification NotificationSubmissionRated{..} = do
+  Sheet{sheetType} <- belongsToJust submissionSheet =<< getJust nSubmission
+  return $ case sheetType of
+    NotGraded -> NTSubmissionRated
+    _other -> NTSubmissionRatedGraded
+classifyNotification NotificationSheetActive{} = return NTSheetActive
+classifyNotification NotificationSheetInactive{} = return NTSheetInactive
+
+
 performJob :: Job -> HandlerT UniWorX IO ()
-performJob JobQueueNotification{ jNotification = n@NotificationSubmissionRated{..} } = do
-  jIds <- runDB . setSerializable $ do
-    Submission{submissionSheet} <- getJust nSubmission
-    isGraded <- (/= NotGraded) . sheetType <$> getJust submissionSheet
-    res <- E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do
-      E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser
-      E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val nSubmission
-      return (user E.^. UserId, user E.^. UserNotificationSettings)
-    let recipients = do
-          (E.Value uid, E.Value nSettings) <- res
-          guard . notificationAllowed nSettings $ bool NTSubmissionRated NTSubmissionRatedGraded isGraded
-          return uid
-    forM recipients $ queueJobUnsafe . flip JobSendNotification n
+performJob JobQueueNotification{jNotification} = do
+  jIds <- runDB. setSerializable $ do
+    candidates <- determineNotificationCandidates jNotification
+    nClass <- classifyNotification jNotification
+    mapM (queueJobUnsafe . flip JobSendNotification jNotification) $ do
+      Entity uid User{userNotificationSettings} <- candidates
+      guard $ notificationAllowed userNotificationSettings nClass
+      return uid
  forM_ jIds $ writeJobCtl . JobCtlPerform
 performJob JobSendNotification{ jNotification = NotificationSubmissionRated{..}, jRecipient } = userMailT jRecipient $ do
  (Course{..}, Sheet{..}, Submission{..}, corrector) <- liftHandlerT . runDB $ do
@ -353,7 +428,39 @@ performJob JobSendNotification{ jNotification = NotificationSubmissionRated{..},
      , "course-school" Aeson..= courseSchool
      ]
    -- provideAlternative $ \(MsgRenderer mr) -> ($(textFile "templates/mail/submissionRated.txt") :: TextUrl (Route UniWorX)) -- textFile does not support control statements
-    providePreferredAlternative $ \(MsgRenderer mr) -> ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+    providePreferredAlternative ($(ihamletFile "templates/mail/submissionRated.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+performJob JobSendNotification{ jNotification = NotificationSheetActive{..}, jRecipient } = userMailT jRecipient $ do
+  (Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do
+    sheet <- getJust nSheet
+    course <- belongsToJust sheetCourse sheet
+    return (course, sheet)
+  setSubjectI $ MsgMailSubjectSheetActive courseShorthand sheetName
+
+  MsgRenderer mr <- getMailMsgRenderer
+  let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
+      tid = courseTerm
+      ssh = courseSchool
+      csh = courseShorthand
+      shn = sheetName
+
+  addAlternatives $ do
+    providePreferredAlternative ($(ihamletFile "templates/mail/sheetActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+performJob JobSendNotification{ jNotification = NotificationSheetInactive{..}, jRecipient } = userMailT jRecipient $ do
+  (Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do
+    sheet <- getJust nSheet
+    course <- belongsToJust sheetCourse sheet
+    return (course, sheet)
+  setSubjectI $ MsgMailSubjectSheetInactive courseShorthand sheetName
+
+  MsgRenderer mr <- getMailMsgRenderer
+  let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
+      tid = courseTerm
+      ssh = courseSchool
+      csh = courseShorthand
+      shn = sheetName
+
+  addAlternatives $ do
+    providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
 performJob JobSendTestEmail{..} = mailT jMailContext $ do
  _mailTo .= [Address Nothing jEmail]
  setSubjectI MsgMailTestSubject
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@ -23,6 +23,8 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
         | JobQueueNotification { jNotification :: Notification }
  deriving (Eq, Ord, Show, Read, Generic, Typeable)
 data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
+                  | NotificationSheetActive { nSheet :: SheetId }
+                  | NotificationSheetInactive { nSheet :: SheetId }
  deriving (Eq, Ord, Show, Read, Generic, Typeable)

 instance Hashable Job
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@ -467,6 +467,8 @@ derivePersistFieldJSON ''Value
 -- Could maybe be replaced with `Structure Notification` in the long term
 data NotificationTrigger = NTSubmissionRatedGraded
                         | NTSubmissionRated
+                         | NTSheetActive
+                         | NTSheetInactive
  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)

 instance Universe NotificationTrigger
@ -493,6 +495,8 @@ instance Default NotificationSettings where
  def = NotificationSettings $ \case
    NTSubmissionRatedGraded -> True
    NTSubmissionRated -> False
+    NTSheetActive -> True
+    NTSheetInactive -> True

 instance ToJSON NotificationSettings where
  toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF
--- a/src/Model/Types/JSON.hs
+++ b/src/Model/Types/JSON.hs
@ -50,7 +50,7 @@ derivePersistFieldJSON n = do
      ]
    , instanceD sqlCxt ([t|PersistFieldSql|] `appT` t)
      [ funD (mkName "sqlType")
-        [ clause [wildP] (normalB [e|SqlOther "json"|]) []
+        [ clause [wildP] (normalB [e|SqlOther "jsonb"|]) []
        ]
      ]
    ]
--- a/templates/mail/sheetActive.hamlet
+++ b/templates/mail/sheetActive.hamlet
@ -0,0 +1,14 @@
+<html>
+  <head>
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailSheetActiveIntro (CI.original courseName) termDesc sheetName}
+    <p>
+      <a href=@{CSheetR tid ssh csh shn SShowR}>
+        #{sheetName}
--- a/templates/mail/sheetInactive.hamlet
+++ b/templates/mail/sheetInactive.hamlet
@ -0,0 +1,14 @@
+<html>
+  <head>
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailSheetInactiveIntro (CI.original courseName) termDesc sheetName}
+    <p>
+      <a href=@{CSheetR tid ssh csh shn SShowR}>
+        #{sheetName}