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 Jobs.Queue

import qualified Data.Set as Set

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

import qualified Data.Conduit.Combinators as C


dispatchJobQueueNotification :: Notification -> JobHandler UniWorX
dispatchJobQueueNotification jNotification = JobHandlerAtomic $
  runConduit $ yield jNotification
            .| transPipe (hoist lift) determineNotificationCandidates
            .| C.filterM (\(notification', Entity _ User{userNotificationSettings}) -> notificationAllowed userNotificationSettings <$> hoist lift (classifyNotification notification'))
            .| C.map (\(notification', Entity uid _) -> JobSendNotification uid notification')
            .| sinkDBJobs


determineNotificationCandidates :: ConduitT Notification (Notification, Entity User) DB ()
determineNotificationCandidates = awaitForever $ \notif -> do
  let withNotif :: ConduitT () (Entity User) DB () -> ConduitT Notification (Notification, Entity User) DB ()
      withNotif c = toProducer c .| C.map (notif, )

      -- | Assumes that conduit produces output sorted by `UserId`
      separateTargets :: Ord target
                      => (Set target -> Notification)
                      -> ConduitT () (Entity User, E.Value target) DB ()
                      -> ConduitT Notification (Notification, Entity User) DB ()
      separateTargets mkNotif' c = toProducer c .| go Nothing Set.empty
        where go Nothing _ = do
                next <- await
                case next of
                  Nothing -> return ()
                  Just (uent, E.Value t) -> go (Just uent) $ Set.singleton t
              go (Just uent) ts = do
                next <- await
                case next of
                  Nothing -> yield (mkNotif' ts, uent)
                  Just next'@(uent', E.Value t)
                    | ((==) `on` entityKey) uent uent' -> go (Just uent) $ Set.insert t ts
                    | otherwise -> yield (mkNotif' ts, uent) >> leftover next' >> go Nothing Set.empty
                
  case notif of
    NotificationSubmissionRated{..}
      -> withNotif . E.selectSource . 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
    NotificationSheetActive{..}
      -> withNotif . E.selectSource . 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
    NotificationSheetHint{..}
      -> withNotif . E.selectSource . 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
    NotificationSheetSolution{..}
      -> withNotif . E.selectSource . 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
    NotificationSheetSoonInactive{..}
      -> withNotif . E.selectSource . 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
    NotificationSheetInactive{..}
      -> withNotif . E.selectSource . 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
    NotificationCorrectionsAssigned{..}
      -> withNotif $ selectSource [UserId ==. nUser] []
    NotificationCorrectionsNotDistributed{nSheet}
      -> withNotif . E.selectSource . 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
    NotificationUserRightsUpdate{..}
      -> do
           -- always send to affected user
           affectedUser <- lift $ selectList [UserId ==. nUser] []
           -- send to same-school admins only if there was an update
           currentAdminSchools <- lift $ 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 <- lift . 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
           withNotif . yieldMany . nub $ affectedUser <> affectedAdmins
    NotificationUserSystemFunctionsUpdate{..}
      -> withNotif $ selectSource [UserId ==. nUser] []
    NotificationUserAuthModeUpdate{..}
      -> withNotif $ selectSource [UserId ==. nUser] []
    NotificationExamRegistrationActive{..}
      -> withNotif . E.selectSource . 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
    NotificationExamRegistrationSoonInactive{..}
      -> withNotif . E.selectSource . 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
    NotificationExamDeregistrationSoonInactive{..}
      -> withNotif . E.selectSource . 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
    NotificationExamResult{..}
      -> do
           lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
           withNotif . E.selectSource . 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
    NotificationAllocationStaffRegister{..}
      -> separateTargets NotificationAllocationStaffRegister . E.selectSource . E.from $ \(user `E.InnerJoin` userFunction `E.InnerJoin` allocation) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocation E.^. AllocationId] $ do
           E.on $ userFunction E.^. UserFunctionSchool E.==. allocation E.^. AllocationSchool
           E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser

           E.where_ $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolLecturer
                E.&&. allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)

           E.where_ . E.exists . E.from $ \userSchool ->
             E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
                  E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. 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.==. allocation E.^. AllocationId

           return (user, allocation E.^. AllocationId)
    NotificationAllocationRegister{..}
      -> separateTargets NotificationAllocationRegister . E.selectSource . E.from $ \(user `E.InnerJoin` allocation) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocation E.^. AllocationId] $ do
           E.on   E.true

           E.where_ $ allocation E.^. AllocationId `E.in_` E.valList (Set.toList nAllocations)

           E.where_ . E.exists . E.from $ \userSchool ->
             E.where_ $ userSchool E.^. UserSchoolUser E.==. user E.^. UserId
                  E.&&. userSchool E.^. UserSchoolSchool E.==. allocation E.^. AllocationSchool
                  E.&&. E.not_ (userSchool E.^. UserSchoolIsOptOut)

           E.where_ . E.not_ . E.exists . E.from $ \application ->
             E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
                  E.&&. application E.^. CourseApplicationUser E.==. user E.^. UserId

           return (user, allocation E.^. AllocationId)
    NotificationAllocationAllocation{..}
      -> separateTargets NotificationAllocationAllocation . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocationCourse E.^. AllocationCourseAllocation] $ do
           E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
           E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
           E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId

           E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)

           E.where_ . E.not_ . E.exists . E.from $ \application ->
             E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
                  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.just (allocationCourse E.^. AllocationCourseAllocation)
                  E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
                  E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId

           return (user, allocationCourse E.^. AllocationCourseAllocation)
    NotificationAllocationUnratedApplications{..}
      -> separateTargets NotificationAllocationUnratedApplications . E.selectSource . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` course `E.InnerJoin` allocationCourse) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId, E.asc $ allocationCourse E.^. AllocationCourseAllocation] $ do
           E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
           E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
           E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId

           E.where_ $ allocationCourse E.^. AllocationCourseAllocation `E.in_` E.valList (Set.toList nAllocations)

           E.where_ . E.exists . E.from $ \application ->
             E.where_ $ application E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
                  E.&&. application E.^. CourseApplicationCourse     E.==. course E.^. CourseId
                  E.&&. application E.^. CourseApplicationUser       E.!=. user E.^. UserId
                  E.&&. E.isNothing (application E.^. CourseApplicationRatingTime)

           return (user, allocationCourse E.^. AllocationCourseAllocation)
    NotificationExamOfficeExamResults{..}
      -> withNotif . E.selectSource . 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
    NotificationExamOfficeExamResultsChanged{..}
      -> withNotif . E.selectSource . 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
    NotificationExamOfficeExternalExamResults{..}
      -> withNotif . E.selectSource . 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
    NotificationAllocationResults{..}
      -> do
           lastExec <- lift . fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
           withNotif . E.selectSource . 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
    NotificationCourseRegistered{..}
     -> withNotif . yieldMMany $ getEntity nUser
    NotificationSubmissionEdited{..}
     -> withNotif . E.selectSource . 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
    NotificationSubmissionUserCreated{..}
      -> withNotif . yieldMMany $ getEntity nUser
    NotificationSubmissionUserDeleted{..}
      -> withNotif . yieldMMany $ 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 NotificationSheetHint{}                      = return NTSheetHint
classifyNotification NotificationSheetSolution{}                  = return NTSheetSolution
classifyNotification NotificationSheetSoonInactive{}              = return NTSheetSoonInactive
classifyNotification NotificationSheetInactive{}                  = return NTSheetInactive
classifyNotification NotificationCorrectionsAssigned{}            = return NTCorrectionsAssigned
classifyNotification NotificationCorrectionsNotDistributed{}      = return NTCorrectionsNotDistributed
classifyNotification NotificationUserRightsUpdate{}               = return NTUserRightsUpdate
classifyNotification NotificationUserSystemFunctionsUpdate{}      = 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 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