From 1ea047263cef7aea153b4b90a7cf7070bb2f1f32 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 24 Aug 2022 14:23:47 +0200 Subject: [PATCH] lpr: auth tag system-printer fully functional --- .../categories/authorization/de-de-formal.msg | 1 + .../uniworx/categories/authorization/en-eu.msg | 3 ++- .../categories/model_types/de-de-formal.msg | 1 + .../uniworx/categories/model_types/en-eu.msg | 1 + .../settings/auth_settings/de-de-formal.msg | 1 + .../settings/auth_settings/en-eu.msg | 1 + models/lms.model | 4 ++-- routes | 4 ++-- src/Handler/Course/Edit.hs | 2 +- src/Handler/Utils/LdapSystemFunctions.hs | 1 + .../Handler/SendNotification/Qualification.hs | 18 +++++++++++------- src/Model/Types/Languages.hs | 2 +- src/Model/Types/Security.hs | 1 + src/Utils/Lang.hs | 11 +++++++++++ 14 files changed, 37 insertions(+), 14 deletions(-) diff --git a/messages/uniworx/categories/authorization/de-de-formal.msg b/messages/uniworx/categories/authorization/de-de-formal.msg index 19764c991..fab2eb322 100644 --- a/messages/uniworx/categories/authorization/de-de-formal.msg +++ b/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. diff --git a/messages/uniworx/categories/authorization/en-eu.msg b/messages/uniworx/categories/authorization/en-eu.msg index f2a64dbe9..f5e82dd4c 100644 --- a/messages/uniworx/categories/authorization/en-eu.msg +++ b/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. diff --git a/messages/uniworx/categories/model_types/de-de-formal.msg b/messages/uniworx/categories/model_types/de-de-formal.msg index a3fd04ca8..fb611d0ab 100644 --- a/messages/uniworx/categories/model_types/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/categories/model_types/en-eu.msg b/messages/uniworx/categories/model_types/en-eu.msg index 2bbb34a44..dd0ec7f95 100644 --- a/messages/uniworx/categories/model_types/en-eu.msg +++ b/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 \ No newline at end of file diff --git a/messages/uniworx/categories/settings/auth_settings/de-de-formal.msg b/messages/uniworx/categories/settings/auth_settings/de-de-formal.msg index 8f9acaa70..95f1a6d85 100644 --- a/messages/uniworx/categories/settings/auth_settings/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/categories/settings/auth_settings/en-eu.msg b/messages/uniworx/categories/settings/auth_settings/en-eu.msg index 1109b0c27..98dcfe1ac 100644 --- a/messages/uniworx/categories/settings/auth_settings/en-eu.msg +++ b/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 diff --git a/models/lms.model b/models/lms.model index 8486ccc5a..0045f740b 100644 --- a/models/lms.model +++ b/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 diff --git a/routes b/routes index d985255e4..4563b0a5f 100644 --- a/routes +++ b/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 diff --git a/src/Handler/Course/Edit.hs b/src/Handler/Course/Edit.hs index a43db9ec1..b29115833 100644 --- a/src/Handler/Course/Edit.hs +++ b/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 diff --git a/src/Handler/Utils/LdapSystemFunctions.hs b/src/Handler/Utils/LdapSystemFunctions.hs index 913ddb503..e541a92e9 100644 --- a/src/Handler/Utils/LdapSystemFunctions.hs +++ b/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 diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index 2469d1f1d..d6837c5a2 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/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 diff --git a/src/Model/Types/Languages.hs b/src/Model/Types/Languages.hs index 0f5568720..e9583795f 100644 --- a/src/Model/Types/Languages.hs +++ b/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) diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs index 5e2661150..dfa135002 100644 --- a/src/Model/Types/Security.hs +++ b/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 diff --git a/src/Utils/Lang.hs b/src/Utils/Lang.hs index e5dc649e3..4168f4df3 100644 --- a/src/Utils/Lang.hs +++ b/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