lpr: auth tag system-printer fully functional

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

@@ -22,6 +22,7 @@ UnauthorizedExamOffice: Sie sind nicht mit Prüfungsverwaltung beauftragt.
 UnauthorizedExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer:innen, für die Sie mit der Prüfungsverwaltung beauftragt sind.
 UnauthorizedSchoolExamOffice: Sie sind nicht mit Prüfungsverwaltung für dieses Institut beauftragt.
 UnauthorizedSystemExamOffice: Sie sind nicht mit systemweiter Prüfungsverwaltung beauftragt.
+UnauthorizedSystemPrinter: Sie sind nicht mit systemweitem Druck und Briefversand beauftragt.
 UnauthorizedExternalExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer:innen, für die Sie mit der Prüfungsverwaltung beauftragt sind.
 UnauthorizedEvaluation: Sie sind nicht mit der Kursumfragenverwaltung beauftragt.
 UnauthorizedAllocationAdmin: Sie sind nicht mit der Administration von Zentralanmeldungen beauftragt.

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

@@ -23,7 +23,8 @@ UnauthorizedEvaluation: You are not charged with course evaluation.
 UnauthorizedAllocationAdmin: You are not charged with the administration of central allocations.
 UnauthorizedExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
 UnauthorizedSchoolExamOffice: You are not part of an exam office for this school.
-UnauthorizedSystemExamOffice: You are not charged with system wide exam administration
+UnauthorizedSystemExamOffice: You are not charged with system wide exam administration.
+UnauthorizedSystemPrinter: You are not charged with system wide letter printing.
 UnauthorizedExternalExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
 UnauthorizedSchoolLecturer: You are no lecturer for this department.
 UnauthorizedLecturer: You are no administrator for this course.

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

@@ -14,3 +14,4 @@ BothSubmissions: Abgabe direkt in Uni2work oder extern mit Pseudonym
 SystemExamOffice: Prüfungsverwaltung
 SystemFaculty: Fakultätsmitglied
 SystemStudent: Student:in
+SystemPrinter: Drucker:in

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

@@ -14,3 +14,4 @@ BothSubmissions: Submission either directly in Uni2work or externally via pseudo
 SystemExamOffice: Exam office
 SystemFaculty: Faculty member
 SystemStudent: Student
+SystemPrinter: Printing staff

messages/uniworx/categories/settings/auth_settings/de-de-formal.msg

@@ -9,6 +9,7 @@ AuthTagFree: Seite ist universell zugänglich
 AuthTagAdmin: Nutzer:in ist Administrator:in
 AuthTagExamOffice: Nutzer:in ist mit Prüfungsverwaltung beauftragt
 AuthTagSystemExamOffice: Nutzer:in ist mit systemweiter Prüfungsverwaltung beauftragt
+AuthTagSystemPrinter: Nutzer:in ist mit systemweiten Druck von Briefen beauftragt
 AuthTagEvaluation: Nutzer:in ist mit Kursumfragenverwaltung beauftragt
 AuthTagAllocationAdmin: Nutzer:in ist mit der Administration von Zentralanmeldungen beauftragt
 AuthTagToken: Nutzer:in präsentiert Authorisierungs-Token

messages/uniworx/categories/settings/auth_settings/en-eu.msg

@@ -9,6 +9,7 @@ AuthTagFree: Page is freely accessable
 AuthTagAdmin: User is administrator
 AuthTagExamOffice: User is part of an exam office
 AuthTagSystemExamOffice: User is charged with system wide exam administration
+AuthTagSystemPrinter: User is responsible for system wide letter printing
 AuthTagEvaluation: User is charged with course evaluation
 AuthTagAllocationAdmin: User is charged with administration of central allocations
 AuthTagToken: User is presenting an authorisation-token

models/lms.model

@@ -1,10 +1,10 @@
 Qualification
   -- INVARIANT: 2*refreshWithin < validDuration 
-  school              SchoolId --TODO: Ansprechpartner der Schule in Briefe erwähnen
+  school              SchoolId                  --TODO: Ansprechpartner der Schule in Briefe erwähnen
   shorthand           (CI Text)
   name                (CI Text)
   description         StoredMarkup Maybe        -- user-defined large Html, ought to contain full description
-  validDuration       Word Maybe    -- qualification is valid indefinitely or for a specified number of months
+  validDuration       Word Maybe                -- qualification is valid indefinitely or for a specified number of months
   auditDuration       Word Maybe                -- number of month to keep audit log; or indefinitely
   refreshWithin       CalendarDiffDays Maybe    -- notify users about renewal within this number of month/days before expiry
   elearningStart      Bool                      -- automatically schedule e-refresher

routes

@@ -63,9 +63,9 @@
 /admin/crontab                AdminCrontabR    GET
 /admin/avs                    AdminAvsR        GET POST
 
-/print                        PrintCenterR     GET POST
+/print                        PrintCenterR     GET POST        !system-printer
 /print/send                   PrintSendR       GET POST
-/print/download/#CryptoUUIDPrintJob   PrintDownloadR    GET
+/print/download/#CryptoUUIDPrintJob   PrintDownloadR    GET    !system-printer
 
 /health                       HealthR          GET             !free
 /instance                     InstanceR        GET             !free

src/Handler/Course/Edit.hs

@@ -475,7 +475,7 @@ pgCEditR tid ssh csh = do
 -- |            since an edit is identified via cfCourseId which is not contained in the received form data for security reasons!
 courseEditHandler :: (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> Maybe CourseForm -> Handler Html
 courseEditHandler miButtonAction mbCourseForm = do
-    aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
+    aid <- requireAuthId
     ((result, formWidget), formEnctype) <- runFormPost $ makeCourseForm miButtonAction mbCourseForm
     formResult result $ \case
       res@CourseForm

src/Handler/Utils/LdapSystemFunctions.hs

@@ -13,3 +13,4 @@ determineSystemFunctions ldapFuncs = \case
   SystemFaculty -> "CN=PROJ-Fahrerausbildung Admin_rw,OU=Projekte,OU=Sicherheitsgruppen,DC=fra,DC=fraport,DC=de" `Set.member` ldapFuncs -- Fahrerausbildungadmins are lecturers
     -- SJ: not sure this LDAP-specific key belongs here?
   SystemStudent -> False -- "student" `Set.member` ldapFuncs -- no such key identified at FraPort
+  SystemPrinter -> False -- "department=IFM-IS2" zu viele Mitglieder

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -38,22 +38,27 @@ dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = use
   addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
 
 
-checkEmailOk :: a -> Bool
+checkEmailOk :: User -> Bool
 checkEmailOk = const True -- TODO
 
 
 dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler ()
 dispatchNotificationQualificationRenewal nQualification jRecipient = do
-  (User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- runDB $ (,,)
+  (recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- runDB $ (,,)
     <$> getJust jRecipient
     <*> getJust nQualification
     <*> getJustBy (UniqueQualificationUser nQualification jRecipient)
-  let qname = CI.original qualificationName
+  let entRecipient = Entity jRecipient recipient
+      qname = CI.original qualificationName
       -- content = $(i18nWidgetFile "qualification/renewal")
   $logDebugS "LMS" $ "Notify " <> tshow jRecipient <> " for renewal of qualification " <> qname
 
+  now <- liftIO getCurrentTime
+  letterDate <- formatTimeUser SelFormatDate now $ Just entRecipient
   let pdfMeta = applyMetas 
-                  [ ("recipient", userDisplayName)                  
+                  [ ("recipient", userDisplayName)
+                  , ("date"     , letterDate)              
+                  , ("lang"     , selectDeEn userLanguages) -- select German or English, see Utils.Lang
                   -- TODO: add more info to interpolate here!
                   ] mempty
   pdfRenewal pdfMeta >>= \case
@@ -61,7 +66,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
       let msg = "Notify " <> tshow jRecipient <> " PDF generation failed with error: " <> err
       $logErrorS "LMS" msg
       error $ unpack msg
-    Right pdf | checkEmailOk userEmail -> userMailT jRecipient $ do
+    Right pdf | checkEmailOk recipient -> userMailT jRecipient $ do
 
         replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
         setSubjectI $ MsgMailSubjectQualificationRenewal qname
@@ -69,8 +74,7 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
         editNotifications <- mkEditNotifications jRecipient -- TODO: add to hamlet file again
         -- let msgrenewal = $(i18nHamletFile "qualification/renewal") -- :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
         -- addHtmlMarkdownAlternatives' msgrenewal
-        
+              
-        now <- liftIO getCurrentTime
         encryptPDF "tomatenmarmelade" pdf >>= \case
           Left err -> do
             let msg = "Notify " <> tshow jRecipient <> "  PDF encryption failed with error: " <> err

src/Model/Types/Languages.hs

@@ -12,7 +12,7 @@ import Model.Types.TH.JSON
 import Control.Lens.TH (makeWrapped)
 
 
-newtype Languages = Languages [Lang]
+newtype Languages = Languages { getLanguages :: [Lang] } 
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
   deriving newtype (FromJSON, ToJSON, IsList)
 

src/Model/Types/Security.hs

@@ -75,6 +75,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
   | AuthTutorControl
   | AuthExamOffice
   | AuthSystemExamOffice
+  | AuthSystemPrinter
   | AuthEvaluation
   | AuthAllocationAdmin  
   | AuthAllocationRegistered

src/Utils/Lang.hs

@@ -2,6 +2,7 @@ module Utils.Lang where
 
 import ClassyPrelude.Yesod
 
+import Model.Types.Languages
 import Utils.Cookies.Registered
 import Utils.Parameters
 import Utils.Session
@@ -31,6 +32,16 @@ isDe = isPrefixOf "de"
 isEn :: Lang -> Bool
 isEn = isPrefixOf "en"
 
+selectDeEn :: Maybe Languages -> Lang
+selectDeEn = selectLanguage' availableLanguages . concatMap getLanguages
+  where 
+    availableLanguages = "de" :| ["en"] -- for now, we only have german and english, with german being the default language
+
+selectEnDe :: Maybe Languages -> Lang
+selectEnDe = selectLanguage' availableLanguages . concatMap getLanguages
+  where 
+    availableLanguages = "en" :| ["de"]
+
 selectLanguage :: MonadHandler m
                => NonEmpty Lang -- ^ Available translations, first is default
                -> m Lang