diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index 25b99e954..5f8a15c73 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -82,14 +82,16 @@ MailBodyQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst MailBodyQualificationExpiry: Diese Qualifikation läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden! MailBodyQualificationExpired: Diese Qualifikation is nun abgelaufen. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen ab sofort nicht länger ausgeübt werden! Es ist möglich, dass die Qualifikation vorzeit ungültig wurde, z.B. wegen erfolgloser Teilnahme an einem verpflichtendem E‑Learning. QualificationActExpire: Auslaufend markieren - keine Benachrichtigung zur Erneuerung senden -QualificationActUnexpire: Auslaufend aufheben - kostenpflichtige Benachrichtigung bei anstehender Erneuerung senden +QualificationActUnexpire: Auslaufend aufheben - zur Erneuerung benachrichtigen +QualificationActUnexpireWarning: Benachrichtigungen bei anstehender Erneuerung können kostenpflichtig sein! QualificationSetExpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E‑Learning abgeschaltet für #{n} #{pluralDE n "Person" "Personen"} QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E‑Learning aktiviert für #{n} #{pluralDE n "Person" "Personen"} QualificationActBlockSupervisor: Dauerhaft entziehen und Ansprechpartner entfernen, mit sofortiger Wirkung QualificationActBlock: Entziehen -QualificationActUnblock: Entzug löschen -QualificationActGrant: Qualifikation vergeben +QualificationActUnblock: Entzug aufheben QualificationActRenew: Qualifikation regulär verlängern +QualificationActGrant: Qualifikation vergeben +QualificationActGrantWarning: Diese Funktion ist nur für seltene Ausnahmefälle vorgesehen! Ein Entzug wird ggf. aufgehoben. QualificationStatusBlock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} entzogen QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach. @@ -98,8 +100,10 @@ LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versende LmsActRenewPin: Neues zufällige E‑Learning Passwort zuweisen LmsActRenewNotify: Neue zufällige E‑Learning Passwort zuweisen und Benachrichtigung per Post oder E-Mail versenden LmsActRestart: E-Learning neu starten -LmsActRestartWarning: Das vorhandene E-Learning wird sofort komplett gelöscht. Benutzer und Passwort werden neu vergeben und es wird eine neue Benachrichtigung versendet werden. +LmsActRestartWarning: Das vorhandene E-Learning wird sofort komplett gelöscht! Für Inhaber einer gültigen Fahrlizenz werden später Benutzer und Passwort neu vergeben und es wird eine neue Benachrichtigung versendet werden. LmsActRestartFeedback n@Int m@Int: #{n}/#{m} E-Learning wurden neu gestartet. +LmsActRestartExtend: Gültig bis ggf. erhöhen für die nächsten # Tage +LmsActRestartUnblock: Entzug ggf. aufheben LmsStatusNotificationSent: Anmeldedaten wurden an Prüfling oder Ansprechpartner per Post oder E#{nonBreakableDash}Mail versendet; E#{nonBreakableDash}Learning ist derzeit offen LmsNotificationSend n@Int: E‑Learning Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet. LmsPinRenewal n@Int: E‑Learning Passwort ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}. diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 8e7eea4b5..21445a418 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -82,14 +82,16 @@ MailBodyQualificationRenewal qname: The qualification #{qname} must be renewed s MailBodyQualificationExpiry: This qualification expires soon. You may then no longer execute any duties that require this qualification as a precondition! MailBodyQualificationExpired: This qualification is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e‑learning. QualificationActExpire: Discontinue - qualification expires silently -QualificationActUnexpire: Continue - send a possibly fee-paying notification upon due renewal +QualificationActUnexpire: Continue - notify for renwals +QualificationActUnexpireWarning: Renewal notification may incur a fee! QualificationSetExpire n: Expiry notification and e‑learning deactivated for #{n} #{pluralENs n "person"} QualificationSetUnexpire n: Expiry notification and e‑learning activated for #{n} #{pluralENs n "person"} QualificationActBlockSupervisor: Waive permanently and remove all supervisiors, effective immediately QualificationActBlock: Revoke QualificationActUnblock: Clear revocation -QualificationActGrant: Grant qualification QualificationActRenew: Renew qualification +QualificationActGrant: Grant qualification +QualificationActGrantWarning: Use with caution in rare exceptional cases only! Any revocation will be undone. QualificationStatusBlock l n m: #{n}/#{m} #{l} revoked QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter. @@ -98,7 +100,9 @@ LmsActNotify: Resend e‑learning notification by post or email LmsActRenewPin: Randomly replace e‑learning password LmsActRenewNotify: Randomly replace e‑learning password and re-send notification by post or email LmsActRestart: Restart e-learning -LmsActRestartWarning: The existing e-learning will be erased immediately. User and password will be generated anew and a notification will be queued as usual. +LmsActRestartWarning: The existing e-learning will be erased immediately! For drivers with a valid licence, user and password will later be generated anew and a notification will be queued as usual. +LmsActRestartExtend: Ensure validity for the next # days +LmsActRestartUnblock: Undo any revocations LmsActRestartFeedback n@Int m@Int: #{n}/#{m} e-learnings were restarted. LmsStatusNotificationSent: E-learning password has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open LmsNotificationSend n: E-learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email. diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 8cfda0043..2fbb562bc 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -330,7 +330,10 @@ embedRenderMessage ''UniWorX ''LmsTableAction id data LmsTableActionData = LmsActNotifyData | LmsActRenewNotifyData | LmsActRenewPinData -- no longer used - | LmsActRestartData + | LmsActRestartData + { lmsActRestartExtend :: Maybe Integer + , lmsActRestartUnblock :: Maybe Bool + } deriving (Eq, Ord, Read, Show, Generic) isNotifyAct :: LmsTableActionData -> Bool @@ -551,8 +554,11 @@ postLmsR sid qsh = do [ singletonMap LmsActNotify $ pure LmsActNotifyData , singletonMap LmsActRenewNotify $ pure LmsActRenewNotifyData -- , singletonMap LmsActRenewPin $ pure LmsActRenewPinData - , singletonMap LmsActRestart $ LmsActRestartData <$ aformMessage msgRestartWarning + , singletonMap LmsActRestart $ LmsActRestartData + <$> aopt intField (fslI MsgLmsActRestartExtend) Nothing + <*> aopt checkBoxField (fslI MsgLmsActRestartUnblock) Nothing -- <*> aopt (commentField MsgQualificationActBlockSupervisor) (fslI MsgMessageWarning) Nothing + <* aformMessage msgRestartWarning ] -- lmsStatusLink = toMaybe isAdmin LmsUserR colChoices cmpMap = mconcat @@ -637,13 +643,36 @@ postLmsR sid qsh = do formResult lmsRes $ \case _ | not isAdmin -> addMessageI Error MsgUnauthorized -- only admins can use the form on this page - (LmsActRestartData, selectedUsers) -> do - delUsers <- runDB $ fromIntegral <$> deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. Set.toList selectedUsers] + (LmsActRestartData{..}, selectedUsers) -> do + let usersList = Set.toList selectedUsers + delUsers <- runDB $ do + when (lmsActRestartUnblock == Just True) $ do + unblockUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList + [ QualificationUserQualification ==. qid + , QualificationUserUser <-. usersList + , QualificationUserBlockedDue !=. Nothing + ] [] + void $ qualificationUserBlocking qid unblockUsers False Nothing + + whenIsJust lmsActRestartExtend $ \extDays -> do + now <- liftIO getCurrentTime + let nowaday = utctDay now + cutoff = addDays extDays nowaday + shortUsers <- view (_entityVal . _qualificationUserUser) <<$>> selectList + [ QualificationUserQualification ==. qid + , QualificationUserUser <-. usersList + , QualificationUserBlockedDue ==. Nothing + , QualificationUserValidUntil <. cutoff + ] [] + forM_ shortUsers $ upsertQualificationUser qid nowaday cutoff Nothing + + fromIntegral <$> deleteWhereCount [LmsUserQualification ==. qid, LmsUserUser <-. usersList] + runDBJobs $ forM_ selectedUsers $ \uid -> queueDBJob $ JobLmsEnqueueUser { jQualification = qid, jUser = uid } let numUsers = length selectedUsers mStatus = bool Success Warning $ delUsers < numUsers - addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers + addMessageI mStatus $ MsgLmsActRestartFeedback delUsers numUsers reloadKeepGetParams $ LmsR sid qsh (action, selectedUsers) | isRenewPinAct action || isNotifyAct action -> do diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 81373f37c..faa429ba9 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -468,7 +468,9 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do getQualificationR, postQualificationR :: SchoolId -> QualificationShorthand -> Handler Html getQualificationR = postQualificationR postQualificationR sid qsh = do - isAdmin <- hasReadAccessTo AdminR + isAdmin <- hasReadAccessTo AdminR + msgGrantWarning <- messageIconI Warning IconWarning MsgQualificationActGrantWarning + msgUnexpire <- messageIconI Info IconWarning MsgQualificationActUnexpireWarning now <- liftIO getCurrentTime let nowaday = utctDay now ((lmsRes, qualificationTable), Entity qid quali) <- runDB $ do @@ -481,7 +483,8 @@ postQualificationR sid qsh = do acts :: Map QualificationTableAction (AForm Handler QualificationTableActionData) acts = mconcat $ [ singletonMap QualificationActExpire $ pure QualificationActExpireData - , singletonMap QualificationActUnexpire $ pure QualificationActUnexpireData + , singletonMap QualificationActUnexpire $ QualificationActUnexpireData + <$ aformMessage msgUnexpire ] ++ bool [ singletonMap QualificationActBlockSupervisor $ pure QualificationActBlockSupervisorData ] -- nonAdmin actions, ie. Supervisor [ singletonMap QualificationActUnblock $ pure QualificationActUnblockData -- Admin-only actions @@ -489,8 +492,9 @@ postQualificationR sid qsh = do <$> apreq textField (fslI MsgQualificationBlockReason) Nothing <*> areq (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgQualificationBlockNotify) (Just False) , singletonMap QualificationActRenew $ pure QualificationActRenewData - , singletonMap QualificationActGrant - (QualificationActGrantData <$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry) + , singletonMap QualificationActGrant $ QualificationActGrantData + <$> apopt dayField (fslI MsgLmsQualificationValidUntil) dayExpiry + <* aformMessage msgGrantWarning ] isAdmin linkLmsUser = toMaybe isAdmin LmsUserR linkUserName = bool ForProfileR ForProfileDataR isAdmin diff --git a/src/Utils.hs b/src/Utils.hs index 0bafb212b..be7a78eef 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -870,6 +870,7 @@ deepAlt altFst _ = altFst maybeEmpty :: Monoid m => Maybe a -> (a -> m) -> m maybeEmpty = flip foldMap +-- | also referred to as whenJust whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenIsJust (Just x) f = f x whenIsJust Nothing _ = return ()