From d6c3cc8c15f5bedd7aaf60ba3392bd77522dbdef Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Thu, 9 May 2019 17:11:23 +0200
Subject: [PATCH] SheetList-prime accessCallback from Course refactored

---
 src/Foundation.hs | 27 ++++++++++++++-------------
 1 file changed, 14 insertions(+), 13 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index d9ec45191..f5b4fa18c 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1825,8 +1825,8 @@ pageActions (CourseR tid ssh csh CShowR) =
       , menuItemRoute = SomeRoute $ CourseR tid ssh csh MaterialListR
       , menuItemModal = False
       , menuItemAccessCallback' =
-          let lecturerAccess     = hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR  -- Always show for lecturers that can create new material
-              materialAccess mnm = hasReadAccessTo  $ CMaterialR tid ssh csh mnm MShowR -- or show if user can see at least one of the contents
+          let lecturerAccess     = hasWriteAccessTo $ CourseR tid ssh csh MaterialNewR  -- Always show for lecturers to create new material
+              materialAccess mnm = hasReadAccessTo  $ CMaterialR tid ssh csh mnm MShowR -- otherwise show only if the user can see at least one of the contents
               existsVisible  = do
                   matNames <- E.select . E.from $ \(course `E.InnerJoin` material) -> do
                     E.on     $ course   E.^. CourseId   E.==.   material E.^. MaterialCourse
@@ -1843,17 +1843,18 @@ pageActions (CourseR tid ssh csh CShowR) =
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetListR
       , menuItemModal = False
-      , menuItemAccessCallback' = do --TODO always show for lecturer
-          let sheetRouteAccess shn = (== Authorized) <$> evalAccess (CSheetR tid ssh csh shn SShowR) False
-          muid <- maybeAuthId
-          (sheets,lecturer) <- runDB $ do
-            cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-            sheets <- map (sheetName.entityVal) <$> selectList [SheetCourse ==. cid] [Desc SheetActiveFrom]
-            lecturer <- case muid of
-                Nothing    -> return False
-                (Just uid) -> existsBy $ UniqueLecturer uid cid
-            return (sheets,lecturer)
-          or2M (return lecturer) $ anyM sheets sheetRouteAccess
+      , menuItemAccessCallback' =
+          let lecturerAccess  = hasWriteAccessTo $ CourseR tid ssh csh SheetNewR  -- Always show for lecturers to create new sheets
+              sheetAccess shn = hasReadAccessTo  $ CSheetR tid ssh csh shn SShowR -- othwerwise show only if the user can see at least one of the contents
+              existsVisible  = do
+                  sheetNames <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
+                    E.on     $ course   E.^. CourseId   E.==.   sheet E.^. SheetCourse
+                    E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
+                        E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
+                        E.&&.  course   E.^. CourseShorthand E.==. E.val csh
+                    return $ sheet E.^. SheetName
+                  anyM sheetNames (sheetAccess . E.unValue)
+          in runDB $ lecturerAccess `or2M` existsVisible
       }
   ] ++ pageActions (CourseR tid ssh csh SheetListR) ++
   [ MenuItem