refactor(letter): sending test letters (WIP)

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

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.

src/Handler/PrintCenter.hs

@@ -73,25 +73,56 @@ instance Default MetaPinRenewal where
           , mppSupervisor= Nothing
           }
 
-makeRenewalForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal
+data LRQF = LRQF 
-makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html -> do
+    { lrqfUser  :: Either UserEmail UserId
-  now_day <- utctDay <$> liftIO getCurrentTime
+    , lrqfSuper :: Maybe (Either UserEmail UserId)
-  flip (renderAForm FormStandard) html $ MetaPinRenewal
+    , lrqfQuali :: Entity Qualification 
-    <$> areq textField        (fslI MsgMppRecipient)         (mppExaminee <$> tmpl)
+    , lrqfIdent :: LmsIdent
-    <*> areq htmlField        (fslI MsgMppAddress)           (mppAddress   <$> tmpl)
+    , lrqfPin   :: Text
-    <*> areq textField        (fslI MsgMppLogin)             (mppLogin     <$> tmpl)
+    , lrqfExpiry:: Day
-    <*> areq textField        (fslI MsgMppPin)               (mppPin       <$> tmpl)
+    } deriving (Eq, Ord, Show, Generic)
-    <*> aopt  urlField        (fslI MsgMppURL)               (mppURL       <$> tmpl)
+
-    <*> areq  dayField        (fslI MsgMppDate)             ((mppDate      <$> tmpl) <|> Just now_day)
+makeRenewalForm :: Maybe LRQF -> Form LRQF
-    <*> areq (langField True) (fslI MsgMppLang)             ((mppLang      <$> tmpl) <|> Just "de-de")
+makeRenewalForm tmpl = identifyForm FIDLmsLetter . validateForm validateLetterRenewQualificationF $ \html -> do
-    <*> aopt textField        (fslI MsgMppOpening)           (mppOpening   <$> tmpl)
+  now_day <- utctDay <$> liftIO getCurrentTime
-    <*> aopt textField        (fslI MsgMppClosing)           (mppClosing   <$> tmpl)
+  flip (renderAForm FormStandard) html $ LRQF
-    <*> aopt textField        (fslI MsgMppSupervisor)        (mppSupervisor<$> tmpl)
+    <$> 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

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)?