fradrive/src/Jobs/Handler/QueueNotification.hs

module Jobs.Handler.QueueNotification
  ( dispatchJobQueueNotification
  ) where

import Import

import Jobs.Types

import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
import Utils.Sql
import Jobs.Queue

import qualified Data.Set as Set

import Handler.Utils.ExamOffice.Exam
import Handler.Utils.ExamOffice.ExternalExam


dispatchJobQueueNotification :: Notification -> Handler ()
dispatchJobQueueNotification jNotification = runDBJobs . setSerializable $ do
  candidates <- hoist lift $ determineNotificationCandidates jNotification
  nClass <- hoist lift $ classifyNotification jNotification
  mapM_ (queueDBJob . flip JobSendNotification jNotification) $ do
    Entity uid User{userNotificationSettings} <- candidates
    guard $ notificationAllowed userNotificationSettings nClass
    return uid


determineNotificationCandidates :: Notification -> DB [Entity User]
determineNotificationCandidates NotificationSubmissionRated{..}
  = E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ 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) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
      E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
      E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
      E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
      return user
determineNotificationCandidates NotificationSheetSoonInactive{..}
  = E.select . E.from $ \(user `E.InnerJoin` courseParticipant `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
      E.on $ sheet E.^. SheetCourse E.==. courseParticipant E.^. CourseParticipantCourse
      E.on $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
      E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
      E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
      return user
determineNotificationCandidates NotificationSheetInactive{..}
  = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
      E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
      E.on $ lecturer E.^. LecturerUser   E.==. user E.^. UserId
      E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
      return user
determineNotificationCandidates NotificationCorrectionsAssigned{..}
  = selectList [UserId ==. nUser] []
determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet}
  = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
      E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse
      E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
      E.where_ $ sheet E.^. SheetId E.==. E.val nSheet
      return user
determineNotificationCandidates NotificationUserRightsUpdate{..} = do
  -- always send to affected user
  affectedUser <- selectList [UserId ==. nUser] []
  -- send to same-school admins only if there was an update
  currentAdminSchools <- setOf (folded . _entityVal . _userFunctionSchool) <$> selectList [UserFunctionUser ==. nUser, UserFunctionFunction ==. SchoolAdmin] []
  let oldAdminSchools = setOf (folded . filtered ((== SchoolAdmin) . view _1) . _2 . from _SchoolId) nOriginalRights
      newAdminSchools = currentAdminSchools `Set.difference` oldAdminSchools
  affectedAdmins <- E.select . E.from $ \(user `E.InnerJoin` admin) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
    E.on $ admin E.^. UserFunctionUser E.==. user E.^. UserId
    E.where_ $ admin E.^. UserFunctionSchool `E.in_` E.valList (Set.toList newAdminSchools)
         E.&&. admin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
    return user
  return . nub $ affectedUser <> affectedAdmins
determineNotificationCandidates NotificationUserAuthModeUpdate{..}
  = selectList [UserId ==. nUser] []
determineNotificationCandidates NotificationExamRegistrationActive{..} =
  E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
    E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
    E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
    E.where_ $ exam E.^. ExamId E.==. E.val nExam
    E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
      E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
           E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
    E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
    return user
determineNotificationCandidates NotificationExamRegistrationSoonInactive{..} =
  E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
    E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
    E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
    E.where_ $ exam E.^. ExamId E.==. E.val nExam
    E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
      E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
           E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
    E.where_ $ courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
    return user
determineNotificationCandidates NotificationExamDeregistrationSoonInactive{..} =
  E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
    E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
    E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
    return user
determineNotificationCandidates notif@NotificationExamResult{..} = do
  lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
  E.select . E.from $ \(examResult `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
    E.on $ examResult E.^. ExamResultUser E.==. user E.^. UserId
    E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
    whenIsJust lastExec $ \lastExec' ->
      E.where_ $ examResult E.^. ExamResultLastChanged E.>. E.val lastExec'
    return user
determineNotificationCandidates NotificationAllocationStaffRegister{..} = do
  Allocation{..} <- getJust nAllocation
  E.select . E.from $ \(user `E.InnerJoin` userFunction) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
    E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
     E.&&. userFunction E.^. UserFunctionSchool E.==. E.val allocationSchool
     E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer

    E.where_ . E.exists . E.from $ \userSchool ->
      E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
           E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool
           E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)
  
    E.where_ . E.not_ . E.exists . E.from $ \(course `E.InnerJoin` lecturer) -> do
      E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
       E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId
      E.where_ . E.exists . E.from $ \allocationCourse ->
        E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
             E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation

    return user
determineNotificationCandidates NotificationAllocationAllocation{..} =
  E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
     E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
    E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
    E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId

    E.where_ . E.not_ . E.exists . E.from $ \application ->
      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
           E.&&. E.not_ (E.isNothing $ application E.^. CourseApplicationRatingTime)

    E.where_ . E.exists . E.from $ \application -> 
      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId

    return user
determineNotificationCandidates NotificationAllocationUnratedApplications{..} =
  E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
     E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
    E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
    E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
  
    E.where_ . E.exists . E.from $ \application ->
      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
           E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)

    return user
determineNotificationCandidates NotificationAllocationRegister{..} = do
  Allocation{..} <- getJust nAllocation
  E.select . E.from $ \user -> do
    E.where_ . E.exists . E.from $ \userSchool ->
      E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
           E.&&. userSchool E.^. UserSchoolSchool E.==. E.val allocationSchool
           E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)

    E.where_ . E.not_ . E.exists . E.from $ \application ->
      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
           E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId

    return user
determineNotificationCandidates NotificationAllocationOutdatedRatings{..} =
  E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
     E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
    E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
    E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
  
    E.where_ . E.exists . E.from $ \application ->
      E.where_ $ application E.^. CourseApplicationAllocation E.==. E.val (Just nAllocation)
           E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
           E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
           E.&&. E.maybe E.false (E.<. application E.^. CourseApplicationTime) (application E.^. CourseApplicationRatingTime)

    return user
determineNotificationCandidates NotificationExamOfficeExamResults{..} =
  E.select . E.from $ \user -> do
    E.where_ . E.exists . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
      E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
    return user
determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} =
  E.select . E.from $ \user -> do
    E.where_ . E.exists . E.from $ \examResult -> do
      E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults)
      E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
    return user
determineNotificationCandidates NotificationExamOfficeExternalExamResults{..} =
  E.select . E.from $ \user -> do
    E.where_ . E.exists . E.from $ \externalExamResult -> do
      E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val nExternalExam
      E.where_ $ examOfficeExternalExamResultAuth (user E.^. UserId) externalExamResult
    return user
determineNotificationCandidates notif@NotificationAllocationResults{..} = do
  lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
  E.select . E.from $ \user -> do
    let isStudent = E.exists . E.from $ \application ->
          E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (E.val nAllocation)
               E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId
        isLecturer = E.exists . E.from $ \(lecturer `E.InnerJoin` allocationCourse) ->
          E.on $ lecturer E.^. LecturerCourse E.==. allocationCourse E.^. AllocationCourseCourse
           E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val nAllocation
           E.&&. lecturer E.^. LecturerUser E.==. user E.^. UserId

        wasAllocated t = E.exists . E.from $ \participant ->
          E.where_ $ participant E.^. CourseParticipantUser E.==. user E.^. UserId
               E.&&. participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
               E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t
               E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
        hasAllocations t = E.exists . E.from $ \(lecturer `E.InnerJoin` participant) -> do
          E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
           E.&&. lecturer E.^. LecturerCourse E.==. participant E.^. CourseParticipantCourse
          E.where_ $ participant E.^. CourseParticipantAllocated E.==. E.just (E.val nAllocation)
               E.&&. participant E.^. CourseParticipantRegistration E.>. E.val t
               E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
    case lastExec of
      Nothing -> E.where_ $ isStudent E.||. isLecturer
      Just t  -> E.where_ $ wasAllocated t E.||. hasAllocations t

    return user
determineNotificationCandidates NotificationCourseRegistered{..} =
  maybeToList <$> getEntity nUser
determineNotificationCandidates NotificationSubmissionEdited{..} =
  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
         E.&&. user E.^. UserId E.!=. E.val nInitiator
    return user
determineNotificationCandidates NotificationSubmissionUserCreated{..} =
  maybeToList <$> getEntity nUser
determineNotificationCandidates NotificationSubmissionUserDeleted{..} =
  maybeToList <$> getEntity nUser


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 NotificationSheetSoonInactive{}              = return NTSheetSoonInactive
classifyNotification NotificationSheetInactive{}                  = return NTSheetInactive
classifyNotification NotificationCorrectionsAssigned{}            = return NTCorrectionsAssigned
classifyNotification NotificationCorrectionsNotDistributed{}      = return NTCorrectionsNotDistributed
classifyNotification NotificationUserRightsUpdate{}               = return NTUserRightsUpdate
classifyNotification NotificationUserAuthModeUpdate{}             = return NTUserAuthModeUpdate
classifyNotification NotificationExamRegistrationActive{}         = return NTExamRegistrationActive
classifyNotification NotificationExamRegistrationSoonInactive{}   = return NTExamRegistrationSoonInactive
classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive
classifyNotification NotificationExamResult{}                     = return NTExamResult
classifyNotification NotificationAllocationStaffRegister{}        = return NTAllocationStaffRegister
classifyNotification NotificationAllocationAllocation{}           = return NTAllocationAllocation
classifyNotification NotificationAllocationRegister{}             = return NTAllocationRegister
classifyNotification NotificationAllocationOutdatedRatings{}      = return NTAllocationOutdatedRatings
classifyNotification NotificationAllocationUnratedApplications{}  = return NTAllocationUnratedApplications
classifyNotification NotificationExamOfficeExamResults{}          = return NTExamOfficeExamResults
classifyNotification NotificationExamOfficeExamResultsChanged{}   = return NTExamOfficeExamResultsChanged
classifyNotification NotificationExamOfficeExternalExamResults{}  = return NTExamOfficeExamResults
classifyNotification NotificationAllocationResults{}              = return NTAllocationResults
classifyNotification NotificationCourseRegistered{}               = return NTCourseRegistered
classifyNotification NotificationSubmissionEdited{}               = return NTSubmissionEdited
classifyNotification NotificationSubmissionUserCreated{}          = return NTSubmissionUserCreated
classifyNotification NotificationSubmissionUserDeleted{}          = return NTSubmissionUserDeleted