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

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

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

import qualified Data.Map as Map


getTCommR, postTCommR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
getTCommR = postTCommR
postTCommR tid ssh csh tutn = do
  ((cid, tutid), usertuts) <- runDB $ do
    tutData@(cid, _) <- fetchCourseIdTutorialId tid ssh csh tutn
    tuts <- selectList [TutorialCourse ==. cid] []
    usertuts <- forMaybeM tuts $ \(Entity tutid Tutorial{..}) -> do
      cID <- encrypt tutid
      guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutorialName TUsersR
      return ( RGTutorialParticipants cID
             , 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
             )
    return (tutData, usertuts)


  commR CommunicationRoute
    { crHeading    = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommTutorialHeading
    , crUltDest    = SomeRoute $ CTutorialR tid ssh csh tutn TCommR
    , crJobs       = crJobsCourseCommunication cid
    , crTestJobs   = crTestJobsCourseCommunication cid
    , crRecipients = Map.fromList $
      [ ( 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
        )
      ] ++ usertuts
    , 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
    }