From 84e73f649aa820a8c09440421f166c3dc7e5ba53 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Sat, 4 May 2019 22:10:08 +0200
Subject: [PATCH] Only show material prime action if it makes sense

---
 messages/uniworx/de.msg |  2 +-
 src/Foundation.hs       | 29 ++++++++++++++++++++++++++++-
 src/Utils.hs            |  7 ++++---
 3 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 91eb63eeb..adfdd8eaf 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -303,7 +303,7 @@ CorByProportionOnly proportion@Rational: #{display proportion} Anteile
 CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Anteile - Tutorium
 CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium
 
-RowCount count@Int64: #{display count} #{pluralDE count "Eintrag" "Einträge"} nach Filter
+RowCount count@Int64: #{display count} #{pluralDE count "passender Eintrag" "passende Einträge"} innsgesamt
 DeleteRow: Entfernen
 ProportionNegative: Anteile dürfen nicht negativ sein
 CorrectorUpdated: Korrektor erfolgreich aktualisiert
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 0e99aba6b..9f11f90bd 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -988,6 +988,22 @@ evalAccess route isWrite = do
 evalAccessDB :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> Bool -> ReaderT (YesodPersistBackend UniWorX) m AuthResult
 evalAccessDB = evalAccess
 
+-- | Check whether the current user is authorized by `evalAccess` for the given route
+--   Convenience function for a commonly used code fragment
+hasAccessTo :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> Bool -> m Bool
+hasAccessTo route isWrite = (== Authorized) <$> evalAccess route isWrite
+
+-- | Check whether the current user is authorized by `evalAccess` to read from the given route
+--   Convenience function for a commonly used code fragment
+hasReadAccessTo :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m Bool
+hasReadAccessTo = flip hasAccessTo False
+
+-- | Check whether the current user is authorized by `evalAccess` to rwrite to the given route
+--   Convenience function for a commonly used code fragment
+hasWriteAccessTo :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m Bool
+hasWriteAccessTo = flip hasAccessTo True
+
+-- | Conditional redirect that hides the URL if the user is not authorized for the route
 redirectAccess :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => Route UniWorX -> m a
 redirectAccess url = do
   -- must hide URL if not authorized
@@ -1780,7 +1796,18 @@ pageActions (CourseR tid ssh csh CShowR) =
       , menuItemIcon  = Nothing
       , menuItemRoute = SomeRoute $ CourseR tid ssh csh MaterialListR
       , menuItemModal = False
-      , menuItemAccessCallback' = return True
+      , 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
+              existsVisible  = do
+                  matNames <- E.select . E.from $ \(course `E.InnerJoin` material) -> do
+                    E.on     $ course   E.^. CourseId   E.==.   material E.^. MaterialCourse
+                    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 $ material E.^. MaterialName
+                  anyM matNames (materialAccess . E.unValue)
+          in runDB $ lecturerAccess `or2M` existsVisible
       }
   , MenuItem
       { menuItemType = PageActionPrime
diff --git a/src/Utils.hs b/src/Utils.hs
index b96684358..5f31dfec5 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -588,7 +588,7 @@ ifM c m m' =
 ifNotM :: Monad m => m Bool -> m a -> m a -> m a
 ifNotM c = flip $ ifM c
 
--- | Monadic boolean function, copied from Andreas Abel's utility function
+-- | Short-circuiting monadic boolean function, copied from Andreas Abel's utility function
 and2M, or2M :: Monad m => m Bool -> m Bool -> m Bool
 and2M ma mb = ifM ma mb (return False)
 or2M ma = ifM ma (return True)
@@ -597,6 +597,7 @@ andM, orM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
 andM = Fold.foldr and2M (return True)
 orM = Fold.foldr or2M (return False)
 
+-- | Short-circuiting monady any
 allM, anyM :: (Functor f, Foldable f, Monad m) => f a -> (a -> m Bool) -> m Bool
 allM xs f = andM $ fmap f xs
 anyM xs f = orM $ fmap f xs
@@ -801,10 +802,10 @@ setLastModified lastModified = do
     $logDebugS "LastModified" $ tshow (lastModified, ifModifiedSince)
     when (maybe False ((lastModified <=) . addUTCTime precision) ifModifiedSince)
       notModified
-  
+
   addHeader "Last-Modified" $ formatRFC1123 lastModified
   where
     precision :: NominalDiffTime
     precision = 1
-    
+
     safeMethods = [ methodGet, methodHead, methodOptions ]