chore(lms): disable some content from lms overview page for non-admins

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -81,3 +81,7 @@ MppRecipient: Empfänger
 MppAddress: Adresse
 MppLang: Sprache
 MppBadLanguage: Sprache muss derzeit "de" oder "en" sein.
+LmsAutomaticQueuing n@Natural: Die folgenden Funktionen werden normalerweise einmal pro Tag um #{show n} Uhr ausgeführt.
+LmsManualQueuing: Die folgenden Funktionen sollten einmal pro Tag ausgeführt werden.
+BtnLmsEnqueue: Nutzer mit ablaufenden Qualifikationen zum E-Learning anmelden und benachrichtigen
+BtnLmsDequeue: Nutzer mit beendetem E-Learning ggf. benachrichtigen und aufräumen 

messages/uniworx/categories/qualification/en-eu.msg

@@ -81,3 +81,7 @@ MppRecipient: Recipient
 MppAddress: Address
 MppLang: Language
 MppBadLanguage: Language currently restricted to "en" or "de".
+LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock.
+LmsManualQueuing: The following functions should be executed daily.
+BtnLmsEnqueue: Enqueue users with expiring qualifications for e-learning and notify them.
+BtnLmsDequeue: Dequeue users with finished e-learning and notify, if appropriate.

routes

@@ -294,16 +294,16 @@
 -- OSIS CSV Export Demo
 /lms                                                    LmsAllR               GET POST  !free -- TODO verify that this is ok
 /lms/#SchoolId                                          LmsSchoolR            GET       !free -- TODO verify that this is ok
-/lms/#SchoolId/#QualificationShorthand                  LmsR  				        GET POST  !free -- TODO Filtering does not work!
+/lms/#SchoolId/#QualificationShorthand                  LmsR  				        GET POST  !free -- 
 /lms/#SchoolId/#QualificationShorthand/edit             LmsEditR			        GET POST
 /lms/#SchoolId/#QualificationShorthand/users            LmsUsersR	            GET
-/lms/#SchoolId/#QualificationShorthand/users/direct     LmsUsersDirectR	      GET       --   development
+/lms/#SchoolId/#QualificationShorthand/users/direct     LmsUsersDirectR	      GET       --   development only
 /lms/#SchoolId/#QualificationShorthand/userlist         LmsUserlistR	        GET POST
-/lms/#SchoolId/#QualificationShorthand/userlist/upload  LmsUserlistUploadR	  GET POST  --   development
+/lms/#SchoolId/#QualificationShorthand/userlist/upload  LmsUserlistUploadR	  GET POST  --   development only
 /lms/#SchoolId/#QualificationShorthand/userlist/direct  LmsUserlistDirectR	      POST  !token
-/lms/#SchoolId/#QualificationShorthand/fake             LmsFakeR              GET POST  !development -- TODO: delete this testing URL
+/lms/#SchoolId/#QualificationShorthand/fake             LmsFakeR              GET POST  -- TODO: delete this testing URL
 /lms/#SchoolId/#QualificationShorthand/result           LmsResultR            GET POST
-/lms/#SchoolId/#QualificationShorthand/result/upload    LmsResultUploadR      GET POST  --   development
+/lms/#SchoolId/#QualificationShorthand/result/upload    LmsResultUploadR      GET POST  -- 	 development only
 /lms/#SchoolId/#QualificationShorthand/result/direct    LmsResultDirectR          POST  !token
 
 /api           ApiDocsR              GET      !free

src/Handler/LMS.hs

@@ -50,19 +50,17 @@ single :: (k,a) -> Map k a
 single = uncurry Map.singleton
 
 -- Button only needed here
-data ButtonManualLms = LmsEnqueue | LmsDequeue
+data ButtonManualLms = BtnLmsEnqueue | BtnLmsDequeue
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Universe ButtonManualLms
 instance Finite   ButtonManualLms
 
 nullaryPathPiece ''ButtonManualLms camelToPathPiece
+embedRenderMessage ''UniWorX ''ButtonManualLms id
 
 instance Button UniWorX ButtonManualLms where
-  btnLabel LmsEnqueue = "Enqeue"
+  btnClasses BtnLmsEnqueue = [BCIsButton, BCPrimary]
-  btnLabel LmsDequeue = "Deqeue"
+  btnClasses BtnLmsDequeue = [BCIsButton, BCDefault]
-
-  btnClasses LmsEnqueue = [BCIsButton, BCPrimary]
-  btnClasses LmsDequeue = [BCIsButton, BCDefault]
 
 
 getLmsSchoolR :: SchoolId -> Handler Html
@@ -71,19 +69,22 @@ getLmsSchoolR ssh = redirect (LmsAllR, [("qualification-overview-school", toPath
 getLmsAllR, postLmsAllR :: Handler Html
 getLmsAllR = postLmsAllR
 postLmsAllR = do
-  ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
-  let btnForm = wrapForm btnWdgt def
-        { formAction   = Just $ SomeRoute LmsAllR
-        , formEncoding = btnEnctype
-        , formSubmit   = FormNoSubmit
-        }
-  case btnResult of
-    (FormSuccess LmsEnqueue) -> queueJob' JobLmsQualificationsEnqueue
-    (FormSuccess LmsDequeue) -> queueJob' JobLmsQualificationsDequeue
-    FormMissing -> return ()
-    _other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
-
   isAdmin <- hasReadAccessTo AdminR
+  mbQcheck <- getsYesod $ view _appQualificationCheckHour
+  -- TODO: Move this functionality elsewhere without the need for `isAdmin`
+  mbBtnForm <- if not isAdmin then return Nothing else do
+    ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
+    case btnResult of
+      (FormSuccess BtnLmsEnqueue) -> queueJob' JobLmsQualificationsEnqueue
+      (FormSuccess BtnLmsDequeue) -> queueJob' JobLmsQualificationsDequeue
+      FormMissing -> return ()
+      _other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
+    return $ Just $ wrapForm btnWdgt def
+              { formAction   = Just $ SomeRoute LmsAllR
+              , formEncoding = btnEnctype
+              , formSubmit   = FormNoSubmit
+              }
+  
   lmsTable <- runDB $ do
     view _2 <$> mkLmsAllTable isAdmin
   siteLayoutMsg MsgMenuQualifications $ do
@@ -120,6 +121,7 @@ mkLmsAllTable isAdmin = do
           return (quali, cactive, cusers)
         dbtRowKey = (E.^. QualificationId)
         dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
+        adminable = if isAdmin then sortable else \_ _ _ -> mempty
         dbtColonnade = dbColonnade $ mconcat
           [ colSchool $ resultAllQualification . _qualificationSchool
           , sortable (Just "qshort")        (i18nCell MsgQualificationShort) $ \(view resultAllQualification -> quali) ->
@@ -147,9 +149,9 @@ mkLmsAllTable isAdmin = do
                         Nothing               -> mempty
                         Just sapId | isAdmin  -> cellTooltipIcon (Just icn) (text2message sapId) mempty
                         Just _                -> iconCell icn 
-          , sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
+          , adminable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
                   $ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
-          , sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal
+          , adminable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal
                                                                         -- \(view resultAllQualificationTotal  -> n) -> wgtCell $ word2widget n
           ]
         dbtSorting = mconcat

templates/lms-all.hamlet

@@ -4,7 +4,15 @@ $# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
 $#
 $# SPDX-License-Identifier: AGPL-3.0-or-later
 
-<p> 
-  ^{btnForm}
 <p>
   ^{lmsTable}
+
+$maybe btnForm <- mbBtnForm
+  <section>
+    <p> 
+      $maybe qcheck <- mbQcheck 
+        _{MsgLmsAutomaticQueuing qcheck}
+      $nothing
+        _{MsgLmsManualQueuing}
+    <p> 
+      ^{btnForm}