From e1b60844cb77b1fd41900d0a3c4829ba21b6b3fe Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Sat, 5 Dec 2020 22:24:25 +0100
Subject: [PATCH] fix: submission download token generation broke viewing

---
 src/Handler/Submission/Download.hs | 37 +++++++++++++++---------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/src/Handler/Submission/Download.hs b/src/Handler/Submission/Download.hs
index 683a0a7df..0e0e1d62c 100644
--- a/src/Handler/Submission/Download.hs
+++ b/src/Handler/Submission/Download.hs
@@ -17,18 +17,18 @@ import qualified Data.Conduit.Combinators as Conduit
 
 
 subDownloadSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> ConduitT () SubmissionFile (YesodDB UniWorX) ()
-subDownloadSource tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
-  (submissionID, isRating) <- lift $ do
-    submissionID <- submissionMatchesSheet tid ssh csh shn cID
+subDownloadSource tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = maybeT (return ()) $ do
+  (submissionID, isRating) <- hoist lift $ do
+    submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
 
-    isRating <- (== Just submissionID) <$> isRatingFile path
+    isRating <- lift $ (== Just submissionID) <$> isRatingFile path
 
     when (isUpdate || isRating) $
-      guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False
+      guardM . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
 
     return (submissionID, isRating)
 
-  unless isRating $ (.| Conduit.map entityVal) . E.selectSource . E.from $ \sf -> do
+  lift . unless isRating $ (.| Conduit.map entityVal) . E.selectSource . E.from $ \sf -> do
     E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
          E.&&. sf E.^. SubmissionFileTitle E.==. E.val path
          E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
@@ -57,22 +57,23 @@ getSubDownloadR tid ssh csh shn cID sft@(submissionFileTypeIsUpdate -> isUpdate)
 
 
 subArchiveSource :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> ConduitT () (Either SubmissionFile DBFile) (YesodDB UniWorX) ()
-subArchiveSource tid ssh csh shn cID sfType = do
+subArchiveSource tid ssh csh shn cID sfType = maybeT (return ()) $ do
   when (sfType == SubmissionCorrected) $
-    guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False
+    guardM . hasReadAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
 
-  submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
-  rating <- lift $ getRating submissionID
+  lift $ do
+    submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
+    rating <- lift $ getRating submissionID
 
-  case sfType of
-    SubmissionOriginal -> (.| Conduit.map (Left . entityVal)) . E.selectSource . E.from $ \sf -> do
-      E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
-           E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
-      return sf
-    _other -> E.selectSource (E.from $ submissionFileQuery submissionID) .| Conduit.map (Left . entityVal)
+    case sfType of
+      SubmissionOriginal -> (.| Conduit.map (Left . entityVal)) . E.selectSource . E.from $ \sf -> do
+        E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
+             E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val False
+        return sf
+      _other -> E.selectSource (E.from $ submissionFileQuery submissionID) .| Conduit.map (Left . entityVal)
 
-  when (sfType == SubmissionCorrected) $
-    maybe (return ()) (yieldM . fmap Right . ratingFile cID) rating
+    when (sfType == SubmissionCorrected) $
+      maybe (return ()) (yieldM . fmap Right . ratingFile cID) rating
 
 getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> Handler TypedContent
 getSubArchiveR tid ssh csh shn cID sfType = do