From 2c3ae0ea83e1cdc2578e1ffdedb42bd02bcbbcee Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 20 Mar 2023 17:12:21 +0000 Subject: [PATCH] refactor(letter): sending test letters (WIP) --- .../categories/qualification/de-de-formal.msg | 11 --- .../categories/qualification/en-eu.msg | 11 --- src/Handler/PrintCenter.hs | 67 ++++++++++++++----- src/Handler/Utils/Form.hs | 3 + 4 files changed, 52 insertions(+), 40 deletions(-) diff --git a/messages/uniworx/categories/qualification/de-de-formal.msg b/messages/uniworx/categories/qualification/de-de-formal.msg index e7ba4ae05..e7e254199 100644 --- a/messages/uniworx/categories/qualification/de-de-formal.msg +++ b/messages/uniworx/categories/qualification/de-de-formal.msg @@ -89,17 +89,6 @@ LmsNotificationSend n@Int: E-Learning Benachrichtigungen an #{n} #{pluralDE n "P LmsPinRenewal n@Int: E-Learning Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}. LmsActionFailed n@Int: Aktion nicht durchgeführt für #{n} #{pluralDE n "Person" "Personen"}, da diese derzeit nicht an einer Prüfung teilnehmen. LmsStarted: E-Learning eröffnet -MppOpening: Anrede -MppClosing: Grußformel -MppSupervisor: Ansprechpartner -MppDate: Datum -MppURL: Link E-Learning -MppLogin !ident-ok: Login -MppPin !ident-ok: Pin -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 diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index ca16f049d..babf4696c 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -89,17 +89,6 @@ LmsNotificationSend n: E-learning notifications will be sent to #{n} #{pluralENs LmsPinRenewal n: E-learning pin replaced randomly for #{n} #{pluralENs n "examinee"}. LmsActionFailed n: No action for #{n} #{pluralENs n "person"}, since there was no ongoing examination. LmsStarted: E-learning open since -MppOpening: Opening -MppClosing: Closing -MppSupervisor: Supervisor -MppDate: Date -MppURL: Link e-learning -MppLogin: Login -MppPin: Pin -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. diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index b04cf8122..e85fa161b 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -73,25 +73,56 @@ instance Default MetaPinRenewal where , mppSupervisor= Nothing } -makeRenewalForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal -makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html -> do - now_day <- utctDay <$> liftIO getCurrentTime - flip (renderAForm FormStandard) html $ MetaPinRenewal - <$> areq textField (fslI MsgMppRecipient) (mppExaminee <$> tmpl) - <*> areq htmlField (fslI MsgMppAddress) (mppAddress <$> tmpl) - <*> areq textField (fslI MsgMppLogin) (mppLogin <$> tmpl) - <*> areq textField (fslI MsgMppPin) (mppPin <$> tmpl) - <*> aopt urlField (fslI MsgMppURL) (mppURL <$> tmpl) - <*> areq dayField (fslI MsgMppDate) ((mppDate <$> tmpl) <|> Just now_day) - <*> areq (langField True) (fslI MsgMppLang) ((mppLang <$> tmpl) <|> Just "de-de") - <*> aopt textField (fslI MsgMppOpening) (mppOpening <$> tmpl) - <*> aopt textField (fslI MsgMppClosing) (mppClosing <$> tmpl) - <*> aopt textField (fslI MsgMppSupervisor) (mppSupervisor<$> tmpl) +data LRQF = LRQF + { lrqfUser :: Either UserEmail UserId + , lrqfSuper :: Maybe (Either UserEmail UserId) + , lrqfQuali :: Entity Qualification + , lrqfIdent :: LmsIdent + , lrqfPin :: Text + , lrqfExpiry:: Day + } deriving (Eq, Ord, Show, Generic) + +makeRenewalForm :: Maybe LRQF -> Form LRQF +makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRenewQualificationF $ \html -> do + now_day <- utctDay <$> liftIO getCurrentTime + flip (renderAForm FormStandard) html $ LRQF + <$> areq userField (fslI MsgLmsUser) (lrqfUser <$> tmpl) + <*> aopt userField (fslI MsgTableSupervisor) (lrqfSuper <$> tmpl) + <*> areq qualificationFieldEnt (fslI MsgQualificationName) (lrqfQuali <$> tmpl) + <$> areq lmsField (fslI MsgTableLmsIdent) (lrqfIdent <$> tmpl) + <*> areq textField (fslI MsgTableLmsPin) (lrqfPin <$> tmpl) + <*> areq dayField (fslI MsgMsgLmsQualificationValidUntil) (lrqfExpiry <$> tmpl) + where + lmsField = convertField LmsIdent getLmsIdent + +validateLetterRenewQualificationF :: FormValidator MetaPinRenewal Handler () +validateLetterRenewQualificationF = -- do + -- MetaPinRenewal{..} <- State.get + return () + +lrqf2letter :: LRQF -> DB (LetterRenewQualificationF, Entity User) +lrqf2letter LRQF{..} = do + usr <- getUser lrqfUser + rcvr <- getUser <$> lrqfSuper + let letter = LetterRenewQualificationF + { lmsLogin = lrqfIdent + , lmsPin = lrqfPin + , qualHolderID = usr ^. _entityKey + , qualHolderDN = usr ^. _userDisplayName + , qualHolderSN = usr ^. _userSurname + , qualExpiry = lrqfExpiry + , qualId = lrqfQuali ^. _entityKey + , qualName = lrqfQuali ^. _qualificationName + , qualShort = lrqfQuali ^. _qualificationShort + , qualSchool = lrqfQuali ^. _qualificationSchool + , qualDuration = lrqfQuali ^. _qualificationValidDuration + } + return (letter, fromMaybe usr rcvr) + where + getUser :: Either UserEmail UserId -> Entity User + getUser (Right uid) = getEntity404 uid + getUser (Left mail) = getBy404 $ UniqueEmail mail -validateMetaPinRenewal :: FormValidator MetaPinRenewal Handler () -validateMetaPinRenewal = do - MetaPinRenewal{..} <- State.get - guardValidation MsgMppBadLanguage $ isDe mppLang || isEn mppLang mprToMeta :: MetaPinRenewal -> P.Meta diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index a4d6fa709..28b1b9d32 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -594,6 +594,9 @@ degreeField = selectField $ optionsPersistKey [] [Asc StudyDegreeName, Asc Study degreeFieldEnt :: Field Handler (Entity StudyDegree) degreeFieldEnt = selectField $ optionsPersist [] [Asc StudyDegreeName, Asc StudyDegreeShorthand, Asc StudyDegreeKey] id +qualificationFieldEnt :: Field Handler (Entity Qualification) +qualificationFieldEnt = selectField $ optionsPersist [] [Asc QualificationName] qualificationName + -- | Select one of the user's primary active study features, or from a given list of StudyFeatures (regardless of user) studyFeaturesPrimaryFieldFor :: Bool -- ^ Allow user to select `Nothing` (only applies if set of options is nonempty)?