From 4791b5bcdab1fc8a33c7793fe5f4d947262c778c Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filipg@amu.edu.pl>
Date: Sat, 28 Mar 2020 20:52:12 +0100
Subject: [PATCH] Check for teachers when considering visibility

---
 Handler/Tables.hs | 33 ++++++++++++++++++++++++++++-----
 1 file changed, 28 insertions(+), 5 deletions(-)

diff --git a/Handler/Tables.hs b/Handler/Tables.hs
index fe7e380..2fa514e 100644
--- a/Handler/Tables.hs
+++ b/Handler/Tables.hs
@@ -202,11 +202,11 @@ theLimitedTextCell h textFun = limitedTextCell h softLimit hardLimit textFun
 statusCellWidget :: Text -> RepoScheme -> Repo -> (SubmissionId, Submission, VariantId, Variant, UserId, Maybe UserId) -> WidgetFor App ()
 statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, userId, mauthId) = do
   isReevaluable <- handlerToWidget $ runDB $ canBeReevaluated submissionId
+  isVisible <- handlerToWidget $ runDB $ checkWhetherVisible submission userId mauthId
   $(widgetFile "submission-status")
     where commitHash = fromSHA1ToText $ submissionCommit submission
           isPublic = submissionIsPublic submission
           isOwner = (mauthId == Just userId)
-          isVisible = checkWhetherVisible submission userId mauthId
           publicSubmissionBranch = getPublicSubmissionBranch submissionId
           maybeBrowsableUrl = if isPublic
                                 then
@@ -215,15 +215,38 @@ statusCellWidget challengeName repoScheme challengeRepo (submissionId, submissio
                                   Nothing
 
 getInfoLink :: Submission -> UserId -> Maybe UserId -> Maybe (Route App)
-getInfoLink submission userId mauthId = if checkWhetherVisible submission userId mauthId
+getInfoLink submission userId mauthId = if checkSimpleVisibility submission userId mauthId
                                         then Just $ QueryResultsR commitHash
                                         else Nothing
    where commitHash = fromSHA1ToText $ submissionCommit submission
 
-checkWhetherVisible :: Submission -> UserId -> Maybe UserId -> Bool
-checkWhetherVisible submission userId mauthId = isPublic || isOwner
+-- sometimes we checker whether we got a teacher, but sometimes
+-- fall back to a simpler check...
+checkSimpleVisibility :: Submission -> UserId -> Maybe UserId -> Bool
+checkSimpleVisibility submission userId mauthId = isPublic || isOwner
+   where isPublic = submissionIsPublic submission
+         isOwner = (mauthId == Just userId)
+
+checkWhetherVisible :: (MonadIO m, BackendCompatible SqlBackend backend, PersistQueryRead backend, PersistUniqueRead backend)
+                      => Submission -> Key User -> Maybe (Key User) -> ReaderT backend m Bool
+checkWhetherVisible submission _ Nothing = return $ submissionIsPublic submission
+checkWhetherVisible submission userId (Just seerId) = do
+  let challengeId = submissionChallenge submission
+  achvs <- E.select $ E.from $ \(achievement, course, participant, teacher) -> do
+     E.where_ (achievement ^. AchievementChallenge E.==. E.val challengeId
+               E.&&. achievement ^. AchievementCourse E.==. course ^. CourseId
+               E.&&. participant ^. ParticipantUser E.==. E.val userId
+               E.&&. participant ^. ParticipantCourse E.==. course ^. CourseId
+               E.&&. teacher ^. TeacherUser E.==. E.val seerId
+               E.&&. teacher ^. TeacherCourse E.==. course ^. CourseId)
+     E.limit 2
+     return ()
+  let isTeacher = case achvs of
+        [] -> False
+        _  -> True
+  return (isPublic || isOwner || isTeacher)
   where isPublic = submissionIsPublic submission
-        isOwner = (mauthId == Just userId)
+        isOwner = (seerId == userId)
 
 getAuxSubmissionEnts :: TestReference -> [TableEntry] -> [(Key User, (User, [(Entity Submission, Entity Variant, Evaluation)]))]
 getAuxSubmissionEnts testId evaluationMaps = map processEvaluationMap evaluationMaps