module Handler.Tutorial.Communication
  ( getTCommR, postTCommR
  ) where

import Import
import Handler.Utils
import Handler.Utils.Tutorial
import Handler.Utils.Communication

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

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

import qualified Data.CaseInsensitive as CI


getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
getTCommR = postTCommR
postTCommR tid ssh csh tutn = do
  jSender <- requireAuthId
  (cid, tutid) <- runDB $ fetchCourseIdTutorialId tid ssh csh tutn

  commR CommunicationRoute
    { crHeading    = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommTutorialHeading
    , crUltDest    = SomeRoute $ CTutorialR tid ssh csh tutn TCommR
    , 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
      [ ( RGTutorialParticipants
        , E.from $ \(user `E.InnerJoin` participant) -> do
            E.on $ user E.^. UserId E.==. participant E.^. TutorialParticipantUser
            E.where_ $ participant E.^. TutorialParticipantTutorial E.==. E.val tutid
            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.&&. corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
            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.&&. tutor E.^. TutorUser E.==. user E.^. UserId
            return user
        )
      ]
    , crRecipientAuth = Just $ \uid -> do
        isTutorialUser <- E.selectExists . E.from $ \tutorialUser ->
          E.where_ $ tutorialUser E.^. TutorialParticipantUser E.==. E.val uid
               E.&&. tutorialUser E.^. TutorialParticipantTutorial E.==. E.val tutid

        isAssociatedCorrector <- evalAccessForDB (Just uid) (CourseR tid ssh csh CNotesR) False
        isAssociatedTutor <- evalAccessForDB (Just uid) (CourseR tid ssh csh CTutorialListR) False

        mr <- getMsgRenderer
        return $ if
          | isTutorialUser -> Authorized
          | otherwise -> orAR mr isAssociatedCorrector isAssociatedTutor
    }