feat(crontab): cronjob for pruning expired invitations

src/Jobs.hs

@@ -66,6 +66,7 @@ import Jobs.Handler.SendCourseCommunication
 import Jobs.Handler.Invitation
 import Jobs.Handler.SendPasswordReset
 import Jobs.Handler.TransactionLog
+import Jobs.Handler.PruneInvitations
 
 import Jobs.HealthReport
 

src/Jobs/Crontab.hs

@@ -12,6 +12,8 @@ import Data.Semigroup (Max(..))
 
 import Data.Time.Zones
 
+import Handler.Utils.DateTime
+
 import Control.Monad.Trans.Writer (WriterT, execWriterT)
 import Control.Monad.Writer.Class (MonadWriter(..))
 
@@ -45,6 +47,16 @@ determineCrontab = execWriterT $ do
       , cronNotAfter = Right CronNotScheduled
       }
   
+  oldestInvitationMUTC <- lift $ preview (_head . _entityVal . _invitationExpiresAt . _Just) <$> selectList [InvitationExpiresAt !=. Nothing] [Asc InvitationExpiresAt, LimitTo 1]
+  whenIsJust oldestInvitationMUTC $ \oldestInvUTC -> tell $ HashMap.singleton
+    (JobCtlQueue JobPruneInvitations)
+    Cron
+      { cronInitial   = CronTimestamp $ utcToLocalTime oldestInvUTC
+      , cronRepeat    = CronRepeatOnChange
+      , cronRateLimit = nominalDay
+      , cronNotAfter  = Right CronNotScheduled
+      }
+
   tell . flip foldMap universeF $ \kind -> 
     case appHealthCheckInterval kind of
       Just int -> HashMap.singleton

src/Jobs/Handler/PruneInvitations.hs

@@ -0,0 +1,13 @@
+module Jobs.Handler.PruneInvitations
+  ( dispatchJobPruneInvitations
+  ) where
+
+import Import
+
+import Database.Persist.Sql (deleteWhereCount)
+
+dispatchJobPruneInvitations :: Handler ()
+dispatchJobPruneInvitations = do
+  now <- liftIO getCurrentTime
+  n <- runDB $ deleteWhereCount [ InvitationExpiresAt <. Just now ]
+  $logInfoS "PruneInvitations" [st|Deleted #{n} expired invitations|]

src/Jobs/Types.hs

@@ -49,6 +49,7 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
          | JobSendPasswordReset { jRecipient :: UserId
                                 }
          | JobTruncateTransactionLog
+         | JobPruneInvitations
          | JobDeleteTransactionLogIPs
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }

src/Utils/Lens.hs

@@ -149,6 +149,8 @@ makeLenses_ ''Occurrences
 
 makeLenses_ ''PredDNF
 
+makeLenses_ ''Invitation
+
 makeLenses_ ''ExamBonusRule
 makeLenses_ ''ExamGradingRule
 makeLenses_ ''ExamResult