module Handler.Course.Communication
  ( postCCommR, getCCommR
  ) where

import Import

import Handler.Utils
import Handler.Utils.Communication

import qualified Data.CaseInsensitive as CI

import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Database.Esqueleto as E


getCCommR, postCCommR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCCommR = postCCommR
postCCommR tid ssh csh = do
  jSender <- requireAuthId
  cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh

  commR CommunicationRoute
    { crHeading    = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommCourseHeading
    , crUltDest    = SomeRoute $ CourseR tid ssh csh CCommR
    , crJobs       = \Communication{..} -> do
        let jSubject = cSubject
            jMailContent = cBody
            jCourse = cid
            allRecipients = Set.toList $ Set.insert (Right jSender) cRecipients
        jMailObjectUUID <- liftIO getRandom
        jAllRecipientAddresses <- lift . fmap Set.fromList . forM allRecipients $ \case
          Left email -> return . Address Nothing $ CI.original email
          Right rid  -> userAddress <$> getJust rid
        forM_ allRecipients $ \jRecipientEmail ->
          yield JobSendCourseCommunication{..}
    , crRecipients = Map.fromList
      [ ( RGCourseParticipants
        , E.from $ \(user `E.InnerJoin` participant) -> do
            E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
            E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
            return user
        )
      , ( RGCourseLecturers
        , E.from $ \(user `E.InnerJoin` lecturer) -> do
            E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
            E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
            return user
        )
      , ( RGCourseCorrectors
        , E.from $ \user -> do
            E.where_ $ E.exists $ E.from $ \(sheet `E.InnerJoin` corrector) -> do
              E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
              E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
                   E.&&. user E.^. UserId E.==. corrector E.^. SheetCorrectorUser
            return user
        )
      , ( RGCourseTutors
        , E.from $ \user -> do
            E.where_ $ E.exists $ E.from $ \(tutorial `E.InnerJoin` tutor) -> do
              E.on $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
              E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
                   E.&&. user E.^. UserId E.==. tutor E.^. TutorUser
            return user
        )
      ]
    , crRecipientAuth = Just $ \uid -> do
        cID <- encrypt uid
        evalAccessDB (CourseR tid ssh csh $ CUserR cID) False
    }