filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

Check for teachers when considering visibility

Browse Source
This commit is contained in:
Filip Gralinski 2020-03-28 20:52:12 +01:00
parent f016e673ce
commit 4791b5bcda
1 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
Handler/Tables.hs
View File

@ -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 :: Text -> RepoScheme -> Repo -> (SubmissionId, Submission, VariantId, Variant, UserId, Maybe UserId) -> WidgetFor App ()
statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, userId, mauthId) = do statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, userId, mauthId) = do
isReevaluable <- handlerToWidget $ runDB $ canBeReevaluated submissionId isReevaluable <- handlerToWidget $ runDB $ canBeReevaluated submissionId
isVisible <- handlerToWidget $ runDB $ checkWhetherVisible submission userId mauthId
$(widgetFile "submission-status") $(widgetFile "submission-status")
where commitHash = fromSHA1ToText $ submissionCommit submission where commitHash = fromSHA1ToText $ submissionCommit submission
isPublic = submissionIsPublic submission isPublic = submissionIsPublic submission
isOwner = (mauthId == Just userId) isOwner = (mauthId == Just userId)
isVisible = checkWhetherVisible submission userId mauthId
publicSubmissionBranch = getPublicSubmissionBranch submissionId publicSubmissionBranch = getPublicSubmissionBranch submissionId
maybeBrowsableUrl = if isPublic maybeBrowsableUrl = if isPublic
then then
@ -215,16 +215,39 @@ statusCellWidget challengeName repoScheme challengeRepo (submissionId, submissio
Nothing Nothing
getInfoLink :: Submission -> UserId -> Maybe UserId -> Maybe (Route App) 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 then Just $ QueryResultsR commitHash
else Nothing else Nothing
where commitHash = fromSHA1ToText $ submissionCommit submission where commitHash = fromSHA1ToText $ submissionCommit submission
checkWhetherVisible :: Submission -> UserId -> Maybe UserId -> Bool -- sometimes we checker whether we got a teacher, but sometimes
checkWhetherVisible submission userId mauthId = isPublic || isOwner -- fall back to a simpler check...
checkSimpleVisibility :: Submission -> UserId -> Maybe UserId -> Bool
checkSimpleVisibility submission userId mauthId = isPublic || isOwner
where isPublic = submissionIsPublic submission where isPublic = submissionIsPublic submission
isOwner = (mauthId == Just userId) 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 = (seerId == userId)
getAuxSubmissionEnts :: TestReference -> [TableEntry] -> [(Key User, (User, [(Entity Submission, Entity Variant, Evaluation)]))] getAuxSubmissionEnts :: TestReference -> [TableEntry] -> [(Key User, (User, [(Entity Submission, Entity Variant, Evaluation)]))]
getAuxSubmissionEnts testId evaluationMaps = map processEvaluationMap evaluationMaps getAuxSubmissionEnts testId evaluationMaps = map processEvaluationMap evaluationMaps
where processEvaluationMap (TableEntry s v (Entity ui u) m _ _ _ _) = (ui, (u, case Map.lookup testId m of where processEvaluationMap (TableEntry s v (Entity ui u) m _ _ _ _) = (ui, (u, case Map.lookup testId m of