chore(lms): allow renewal of pins and manual notification sending

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

@@ -44,6 +44,9 @@ LmsDirectUpload: Direkter Upload für automatisierte Systeme
 LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
 MailSubjectQualificationRenewal qname@Text: Ihre Qualifikation #{qname} muss demnächst erneuert werden
 MailSubjectQualificationExpiry qname@Text: Ihre Qualifikation #{qname} läuft demnächst ab
-MailLmsRenewalBody: Sie müssen diese Qualifikaton demnächst durch einen E-Learning Kurs erneuern.
-LmsActNotify: Benachrichtigung E-Lernen erneut versenden
-LmsActRenewPin: Neue zufällig E-Lernen PIN setzen
+MailLmsRenewalBody: Sie müssen diese Qualifikaton demnächst durch einen E-Lernen Kurs erneuern.
+LmsActNotify: Benachrichtigung E-Lernen erneut per Post oder E-Mail versenden
+LmsActRenewPin: Neue zufällige E-Lernen PIN zuweisen
+LmsActRenewNotify: Neue zufällige E-Lernen PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden
+LmsNotificationSend n@Int: E-Lernen Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet.
+LmsPinRenewal n@Int: E-Lernen Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}. 

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

@@ -45,5 +45,8 @@ LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically
 MailSubjectQualificationRenewal qname@Text: Your qualification #{qname} must be renewed shortly
 MailSubjectQualificationExpiry qname@Text: Your qualification #{qname} expires soon
 MailLmsRenewalBody: You will soon need to renew this qualficiation by completing an e-learning course.
-LmsActNotify: Send e-learning notification again
-LmsActRenewPin: Randomly replace e-learning PIN
+LmsActNotify: Resend e-learning notification by post or email
+LmsActRenewPin: Randomly replace e-learning PIN
+LmsActRenewNotify: Randomly replace e-learning PIN and re-send notification by post or email
+LmsNotificationSend n@Int: E-learning notifications will be sent to #{n} #{pluralEN n "Examinee" "Examinees"} by letter post or by email.
+LmsPinRenewal n@Int: E-learning pin replaced randomly for #{n} #{pluralEN n "Examinee" "Examinees"}.

models/lms.model

@@ -101,7 +101,8 @@ LmsUser
   received          UTCTime Maybe               -- last acknowledgement by LMS 
   ended             UTCTime Maybe               -- ident was deleted from LMS 
   -- Primary ident -- newtype Key LmsUserId = LmsUserKey { unLmsUser :: Text } -- change LmsIdent -> Text. Do we want this?
-  UniqueLmsUser ident -- idents must be unique accross all qualifications, since idents are global within LMS!
+  UniqueLmsIdent ident                           -- idents must be unique accross all qualifications, since idents are global within LMS!
+  UniqueLmsQualificationUser qualification user  -- each user may be enrolled at most once per course
   deriving Generic
 
 -- LmsUserlist stores LMS upload for later processing only 

src/Handler/LMS.hs

@@ -20,8 +20,10 @@ import Import
 import Jobs
 import Handler.Utils
 -- import Handler.Utils.Csv
--- import Handler.Utils.LMS
+import Handler.Utils.LMS
 
+
+import qualified Data.Set as Set
 import qualified Data.Map as Map
 -- import qualified Data.Csv as Csv
 -- import qualified Data.Conduit.List as C
@@ -197,6 +199,7 @@ instance HasUser LmsTableData where
   hasUser = resultUser . _entityVal
 
 data LmsTableAction = LmsActNotify
+                    | LmsActRenewNotify
                     | LmsActRenewPin
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
@@ -207,9 +210,19 @@ embedRenderMessage ''UniWorX ''LmsTableAction id
 
 -- Not yet needed, since there is no additional data for now:
 data LmsTableActionData = LmsActNotifyData
-                        | LmsActRenewPinData
+                        | LmsActRenewNotifyData
+                        | LmsActRenewPinData                        
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
+isNotifyAct :: LmsTableActionData -> Bool
+isNotifyAct LmsActNotifyData      = True
+isNotifyAct LmsActRenewNotifyData = True 
+isNotifyAct LmsActRenewPinData    = False 
+
+isRenewPinAct :: LmsTableActionData -> Bool
+isRenewPinAct LmsActNotifyData      = False
+isRenewPinAct LmsActRenewNotifyData = True 
+isRenewPinAct LmsActRenewPinData    = True 
 
 lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
                                                                , E.SqlExpr (Entity User)
@@ -321,11 +334,13 @@ postLmsR sid qsh = do
     qent <- getBy404 $ SchoolQualificationShort sid qsh
     let acts :: Map LmsTableAction (AForm Handler LmsTableActionData)
         acts = mconcat
-          [ singletonMap LmsActNotify    $ pure LmsActNotifyData
-          , singletonMap LmsActRenewPin  $ pure LmsActRenewPinData
+          [ singletonMap LmsActNotify       $ pure LmsActNotifyData
+          , singletonMap LmsActRenewNotify  $ pure LmsActRenewNotifyData
+          , singletonMap LmsActRenewPin     $ pure LmsActRenewPinData
           ]
         colChoices = mconcat
-          [ colUserNameLinkHdr MsgTableLmsUser AdminUserR
+          [ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
+          , colUserNameLinkHdr MsgTableLmsUser AdminUserR
           , colUserEmail
           , sortable (Just "valid-until")   (i18nCell MsgTableQualificationValidUntil) $ \(   view $ resultQualUser . _entityVal . _qualificationUserValidUntil  -> d)  -> dayCell d
           , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh)$ \(   view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d)  -> dayCell d
@@ -344,13 +359,16 @@ postLmsR sid qsh = do
     return (tbl, qent)
 
   formResult lmsRes $ \case
-    (LmsActNotifyData, selectedUsers) -> do         
-      forM_ selectedUsers $ \uid -> 
-        runDBJobs $ queueDBJob (JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid})
-    (LmsActRenewPinData, selectedUsers) -> do         
-      --TODO Dummy, we need a DB action here
-      forM_ selectedUsers $ \uid -> 
-        runDBJobs $ queueDBJob (JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid})
+    (action, selectedUsers) -> do --   | isRenewPinAct action || isNotifyAct action -> do
+      runDBJobs $ forM_ selectedUsers $ \uid -> do
+        when (isRenewPinAct action) $ do
+          newPin <- liftIO randomLMSpw
+          updateBy (UniqueLmsQualificationUser qid uid) [LmsUserPin =. newPin] -- must be within its own runDB
+        when (isNotifyAct action) $ 
+          queueDBJob $ JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid}
+      let numExaminees = Set.size selectedUsers
+      when (isRenewPinAct action) $ addMessageI Success $ MsgLmsPinRenewal       numExaminees
+      when (isNotifyAct action)   $ addMessageI Success $ MsgLmsNotificationSend numExaminees
   
   let heading = citext2widget $ qualificationName quali
   siteLayout heading $ do