From d59f6860215ebbffde61062a501b5eeeabdb58ae Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Wed, 19 May 2021 14:50:28 +0200
Subject: [PATCH] fix: properly apply auth to corrections in sheet table

Fixes #700
---
 src/Handler/Sheet/List.hs        | 18 +++++++++---------
 src/Handler/Utils/Table/Cells.hs |  7 +++++++
 2 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/src/Handler/Sheet/List.hs b/src/Handler/Sheet/List.hs
index 45dc6a14a..4593fb9f0 100644
--- a/src/Handler/Sheet/List.hs
+++ b/src/Handler/Sheet/List.hs
@@ -93,11 +93,8 @@ getSheetListR tid ssh csh = do
                       cid' <- encrypt sid
                       return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
                     acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
-                    tellStats = do
-                      r <- mkRoute
-                      showRating <- lift $ hasReadAccessTo r
-                      tell . stats $ bool Nothing submissionRatingPoints showRating
-                in acell & cellContents %~ (<* tellStats)
+                    tellStats = tell $ stats submissionRatingPoints
+                in guardAuthCell ((, False) <$> mkRoute) $ acell & cellContents %~ (<* tellStats)
 
       , sortable Nothing -- (Just "percent")
                         (i18nCell MsgRatingPercent)
@@ -105,10 +102,13 @@ getSheetListR tid ssh csh = do
               (Just (Entity sid Submission{submissionRatingPoints=Just sPoints})) ->
                 case preview (_grading . _maxPoints) sType of
                   Just maxPoints
-                    | maxPoints /= 0 -> cell $ do
-                        cID <- encrypt sid
-                        showRating <- hasReadAccessTo $ CSubmissionR tid ssh csh sheetName cID CorrectionR
-                        bool (return ()) (toWidget . toMessage $ textPercent sPoints maxPoints) showRating
+                    | maxPoints /= 0 ->
+                        let
+                          mkRoute = liftHandler $ do
+                            cid' <- encrypt sid
+                            return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
+                        in guardAuthCell ((, False) <$> mkRoute) . cell $ do
+                             toWidget . toMessage $ textPercent sPoints maxPoints
                   _other -> mempty
               _other -> mempty
       ]
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index b923d34ed..de4a266c0 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -65,6 +65,13 @@ linkEmptyCell = anchorCell
 msgCell :: (ToMessage t, IsDBTable m a) => t -> DBCell m a
 msgCell = textCell . toMessage
 
+guardAuthCell :: (IsDBTable m a, MonadAP m, MonadThrow m)
+              => m (Route UniWorX, Bool) -- ^ @(route, isWrite)@
+              -> DBCell m a -> DBCell m a
+guardAuthCell mkParams = over cellContents $ \act -> do
+  (route, isWrite) <- lift mkParams
+  ifM (fmap (is _Authorized) . lift $ evalAccess route isWrite) act (return mempty)
+
 -- Recall: for line numbers, use dbRow
 
 ---------------------