-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Utils.Course
  ( mayViewCourse, mayViewCourse', mayEditCourse, mayEditCourse'
  , isSchoolAdmin, isSchoolAdminLike
  , isCourseLecturer, isCourseTutor, isCourseSheetCorrector, isCourseExamCorrector
  , isCourseParticipant
  , isCourseAssociated
  , courseIsVisible, courseIsVisible'
  , numCourseParticipants
  ) where

import Import.NoFoundation

import qualified Database.Esqueleto.Legacy as E
import qualified Database.Esqueleto.Utils as E


mayViewCourse :: Maybe UserId
              -> AuthTagActive
              -> UTCTime
              -> E.SqlExpr (Entity Course)
              -> E.SqlExpr (E.Value Bool)
mayViewCourse muid ata now course = 
        isSchoolAdminLike  muid ata (course E.^. CourseSchool)
  E.||. mayEditCourse      muid ata  course
  E.||. isCourseAssociated muid ata (course E.^. CourseId)
  E.||. courseIsVisible         now  course

mayViewCourse' :: Maybe UserId
               -> AuthTagActive
               -> UTCTime
               -> Entity Course
               -> E.SqlExpr (E.Value Bool)
mayViewCourse' muid ata now c@(Entity cid Course{courseSchool}) = 
        isSchoolAdminLike  muid ata (E.val courseSchool)
  E.||. mayEditCourse'     muid ata  c
  E.||. isCourseAssociated muid ata (E.val cid)
  E.||. courseIsVisible'        now  c


mayEditCourse :: Maybe UserId -> AuthTagActive -> E.SqlExpr (Entity Course) -> E.SqlExpr (E.Value Bool)
mayEditCourse muid ata course = 
        isSchoolAdmin    muid ata (course E.^. CourseSchool)
  E.||. isCourseLecturer muid ata (course E.^. CourseId)

mayEditCourse' :: Maybe UserId -> AuthTagActive -> Entity Course -> E.SqlExpr (E.Value Bool)
mayEditCourse' muid ata (Entity cid Course{..}) = 
        isSchoolAdmin    muid ata (E.val courseSchool)
  E.||. isCourseLecturer muid ata (E.val cid)


isSchoolAdmin :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
isSchoolAdmin muid AuthTagActive{..} ssh
  | Just uid <- muid, authTagIsActive AuthAdmin = E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
    E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
    E.where_ $ user      E.^. UserId               E.==. E.val uid
      E.&&. userFunction E.^. UserFunctionSchool   E.==. ssh
      E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
  | otherwise = E.false

isSchoolAdminLike :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value SchoolId) -> E.SqlExpr (E.Value Bool)
isSchoolAdminLike muid ata@AuthTagActive{..} ssh
  | Just uid <- muid = isSchoolAdmin muid ata ssh E.||. (E.exists . E.from $ \(user `E.InnerJoin` userFunction) -> do
    E.on $ user E.^. UserId E.==. userFunction E.^. UserFunctionUser
    E.where_ $ user         E.^. UserId               E.==. E.val uid
      E.&&.    userFunction E.^. UserFunctionSchool   E.==. ssh
      E.&&. ( (userFunction E.^. UserFunctionFunction E.==. E.val SchoolEvaluation
          E.&&. E.val (authTagIsActive AuthEvaluation))
        E.||. (userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
          E.&&. E.val (authTagIsActive AuthExamOffice))
      )
    )
  | otherwise = E.false

isCourseLecturer :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseLecturer muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthLecturer = E.exists . E.from $ \(user `E.InnerJoin` lecturer) -> do
    E.on $     user  E.^. UserId         E.==. lecturer E.^. LecturerUser
    E.where_ $ user  E.^. UserId         E.==. E.val uid
      E.&&. lecturer E.^. LecturerCourse E.==. cid
  | otherwise = E.false

isCourseTutor :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseTutor muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthTutor = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
    E.on $     tutor E.^. TutorTutorial  E.==. tutorial E.^. TutorialId
    E.where_ $ tutor E.^. TutorUser      E.==. E.val uid
      E.&&. tutorial E.^. TutorialCourse E.==. cid
  | otherwise = E.false

isCourseSheetCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseSheetCorrector muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthCorrector = E.exists . E.from $ \(sheetCorrector `E.InnerJoin` sheet) -> do
    E.on $     sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
    E.where_ $ sheetCorrector E.^. SheetCorrectorUser  E.==. E.val uid
      E.&&.    sheet          E.^. SheetCourse         E.==. cid
  | otherwise = E.false

isCourseExamCorrector :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseExamCorrector muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthExamCorrector = E.exists . E.from $ \(examCorrector `E.InnerJoin` exam) -> do
    E.on $     examCorrector E.^. ExamCorrectorExam E.==. exam E.^. ExamId
    E.where_ $ examCorrector E.^. ExamCorrectorUser E.==. E.val uid
      E.&&.    exam          E.^. ExamCourse        E.==. cid
  | otherwise = E.false

isCourseParticipant :: Maybe UserId -> AuthTagActive -> E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Bool)
isCourseParticipant muid AuthTagActive{..} cid
  | Just uid <- muid, authTagIsActive AuthCourseRegistered = E.exists . E.from $ \courseParticipant -> E.where_ $ 
          courseParticipant E.^. CourseParticipantUser   E.==. E.val uid
    E.&&. courseParticipant E.^. CourseParticipantCourse E.==. cid
    E.&&. courseParticipant E.^. CourseParticipantState  E.==. E.val CourseParticipantActive
    E.&&. E.val (authTagIsActive AuthCourseRegistered)
  | otherwise = E.false

isCourseAssociated :: Maybe UserId
                   -> AuthTagActive
                   -> E.SqlExpr (E.Value CourseId)
                   -> E.SqlExpr (E.Value Bool)
isCourseAssociated muid ata cid = 
        isCourseLecturer       muid ata cid
  E.||. isCourseTutor          muid ata cid
  E.||. isCourseSheetCorrector muid ata cid
  E.||. isCourseExamCorrector  muid ata cid
  E.||. isCourseParticipant    muid ata cid


courseIsVisible :: UTCTime
                -> E.SqlExpr (Entity Course)
                -> E.SqlExpr (E.Value Bool)
courseIsVisible now course = 
  E.maybe E.false (\visibleFrom -> visibleFrom E.<=. E.val now) (course E.^. CourseVisibleFrom)
    E.&&. E.maybe E.true (\visibleTo -> E.val now E.<=. visibleTo) (course E.^. CourseVisibleTo)

courseIsVisible' :: UTCTime
                 -> Entity Course
                 -> E.SqlExpr (E.Value Bool)
courseIsVisible' now (Entity _cid Course{..}) = E.val (NTop courseVisibleFrom <= now' && now' <= NTop courseVisibleTo)
  where now' = NTop $ Just now


numCourseParticipants :: E.SqlExpr (E.Value CourseId) -> E.SqlExpr (E.Value Int)
numCourseParticipants cid = E.subSelectCount . E.from $ \courseParticipant ->
  E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. cid
       E.&&. courseParticipant E.^. CourseParticipantState  E.==. E.val CourseParticipantActive