chore(lms): deactivate lms actions for supervisors

src/Handler/LMS.hs

@@ -312,7 +312,7 @@ embedRenderMessage ''UniWorX ''LmsTableAction id
 -- Not yet needed, since there is no additional data for now:
 data LmsTableActionData = LmsActNotifyData
                         | LmsActRenewNotifyData
-                        | LmsActRenewPinData
+                        | LmsActRenewPinData          -- no longer used
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 isNotifyAct :: LmsTableActionData -> Bool
@@ -363,13 +363,14 @@ mkLmsTable :: forall h p cols act act'.
               , Ord act, PathPiece act, RenderMessage UniWorX act
               , AsCornice h p LmsTableData (DBCell (MForm Handler) (FormResult (First act', DBFormResult UserId Bool                                        LmsTableData))) cols
               )
-           => Entity Qualification
+           => Bool
+           -> Entity Qualification
            -> Map act (AForm Handler act')
            -> (LmsTableExpr -> E.SqlExpr (E.Value Bool))
            -> cols
            -> PSValidator (MForm Handler) (FormResult (First act', DBFormResult UserId Bool LmsTableData))
            -> DB (FormResult (act', Set UserId), Widget)
-mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
+mkLmsTable isAdmin (Entity qid quali) acts restrict cols psValidator = do
   now <- liftIO getCurrentTime
   -- currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute -- we know the route here
   let
@@ -462,7 +463,8 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
           <*> (join . preview (resultLmsUser  . _entityVal . _lmsUserEnded))
     dbtCsvDecode = Nothing
     dbtExtraReps = []
-    dbtParams = DBParamsForm
+    dbtParams = if not isAdmin then def {dbParamsFormAction = Nothing, dbParamsFormSubmit = FormNoSubmit} else 
+      DBParamsForm
       { dbParamsFormMethod = POST
       , dbParamsFormAction = Just $ SomeRoute currentRoute
       , dbParamsFormAttrs  = []
@@ -496,6 +498,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
 getLmsR,  postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
 getLmsR = postLmsR
 postLmsR sid qsh = do
+  isAdmin <- hasReadAccessTo AdminR
   currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
   ((lmsRes, lmsTable), Entity qid quali) <- runDB $ do
     qent <- getBy404 $ SchoolQualificationShort sid qsh
@@ -503,10 +506,10 @@ postLmsR sid qsh = do
         acts = mconcat
           [ singletonMap LmsActNotify       $ pure LmsActNotifyData
           , singletonMap LmsActRenewNotify  $ pure LmsActRenewNotifyData
-          , singletonMap LmsActRenewPin     $ pure LmsActRenewPinData
+          -- , singletonMap LmsActRenewPin     $ pure LmsActRenewPinData
           ]
         colChoices = mconcat
-          [ dbSelectIf (applying _2) id (return . view (resultUser . _entityKey)) (\r -> isJust $ r ^? resultLmsUser) -- TODO: refactor using  function "is"
+          [ if not isAdmin then mempty else dbSelectIf (applying _2) id (return . view (resultUser . _entityKey)) (\r -> isJust $ r ^? resultLmsUser) -- TODO: refactor using  function "is"
           , colUserNameLinkHdr MsgLmsUser AdminUserR
           , colUserEmail
           , sortable (Just "valid-until")   (i18nCell MsgLmsQualificationValidUntil)   $ \(   view $ resultQualUser . _entityVal . _qualificationUserValidUntil  -> d)  -> dayCell d
@@ -570,10 +573,11 @@ postLmsR sid qsh = do
             -- i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
             i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
         psValidator = def & forceFilter "may-access" (Any True)
-    tbl <- mkLmsTable qent acts (const E.true) colChoices psValidator
+    tbl <- mkLmsTable isAdmin qent acts (const E.true) colChoices psValidator
     return (tbl, qent)
 
   formResult lmsRes $ \case
+    _ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page
     (action, selectedUsers) -> do --   | isRenewPinAct action || isNotifyAct action -> do
       now <- liftIO getCurrentTime
       numExaminees <- runDBJobs $ do
@@ -592,6 +596,7 @@ postLmsR sid qsh = do
       when (diffSelected /= 0)    $ addMessageI Warning $ MsgLmsActionFailed     diffSelected
       redirect currentRoute
     
+
   let heading = citext2widget $ qualificationName quali
   siteLayout heading $ do
     setTitle $ toHtml $ unSchoolKey sid <> "-" <> qsh