Merge branch 'master' into fradrive/split-lms

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+## [27.0.19](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.0.18...v27.0.19) (2023-01-27)
+
 ## [27.0.18](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.0.17...v27.0.18) (2023-01-25)
 
 ## [27.0.17](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.0.16...v27.0.17) (2023-01-22)

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

@@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer
 AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
 LicenceTableChangeAvs: Im AVS ändern
 LicenceTableGrantFDrive: In FRADrive erteilen
-LicenceTableRevokeFDrive: In FRADrive entziehen
+LicenceTableRevokeFDrive: In FRADrive zum Vortag entziehen

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

@@ -28,4 +28,4 @@ RevokeUnknownLicencesFail: Not all AVS driving licences of unknown drivers could
 AvsCommunicationError: AVS interface returned an unexpected error.
 LicenceTableChangeAvs: Change in AVS
 LicenceTableGrantFDrive: Grant in FRADrive
-LicenceTableRevokeFDrive: Revoke in FRADrive
+LicenceTableRevokeFDrive: Revoke yesterday in FRADrive

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

@@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Kursteilnehmer:innen hinzufügen
 CourseParticipantsRegisterActionAddParticipants: Personen zum Kurs anmelden
 CourseParticipantsRegisterActionAddTutorialMembers: Personen zu Kurs und Übungsgruppe anmelden
 CourseParticipantsRegisterUsersField: Zum Kurs anzumeldende Personen
-CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma getrennt angeben.
+CourseParticipantsRegisterUsersFieldTip: Bitte Ausweiskartennummer inklusive Punkt, Fraport Personalnummer oder Email angeben. Mehrere Personen bitte mit Komma oder Leerzeichen trennen.
 CourseParticipantsRegisterTutorialOption: Kursteilnehmer:innen zu Übungsgruppe anmelden?
 CourseParticipantsRegisterTutorialField: Übungsgruppe
 CourseParticipantsRegisterTutorialFieldTip: Ist aktuell keine Übungsgruppe mit diesem Namen vorhanden, wird eine neue erstellt. Ist bereits eine Übungsgruppe mit diesem Namen vorhanden, werden die Kursteilnehmenden dieser hinzugefügt.

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

@@ -83,7 +83,7 @@ CourseParticipantsRegisterHeading: Add course participants
 CourseParticipantsRegisterActionAddParticipants: Add course participants
 CourseParticipantsRegisterActionAddTutorialMembers: Add course and tutorial participants
 CourseParticipantsRegisterUsersField: Persons to register for course
-CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with commas.
+CourseParticipantsRegisterUsersFieldTip: Please enter id card no (including dot), Fraport personnel number or email. Please separate multiple entries with comma or space.
 CourseParticipantsRegisterTutorialOption: Register course participants for tutorial?
 CourseParticipantsRegisterTutorialField: Tutorial
 CourseParticipantsRegisterTutorialFieldTip: If there is no tutorial with this name, a new one will be created. If there is a tutorial with this name, the course participants will be registered for it.

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

@@ -21,9 +21,10 @@ LmsQualificationValidUntil: Gültig bis
 TableQualificationLastRefresh: Zuletzt erneuert
 TableQualificationFirstHeld: Erstmalig
 TableQualificationBlockedDue: Suspendiert
-TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und wer hat das veranlasst?
+TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend außer Kraft gesetzt und warum wurde dies veranlasst?
 TableQualificationNoRenewal: Storniert
-TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versand, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
+TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch gültig sein.
+QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
 LmsUser: Inhaber
 TableLmsEmail: E-Mail
 TableLmsIdent: LMS Identifikation
@@ -36,6 +37,7 @@ TableLmsStaff: Interner Mitarbeiter?
 TableLmsStarted: Begonnen
 TableLmsReceived: Letzte Rückmeldung
 TableLmsNotified: Versand Benachrichtigung
+TableLmsNotifiedTooltip: Benachrichtigungen werden erst versendet wenn das LMS bestätigt die Eröffnung des E-Learning für den Benutzer bestätigt hat, was ein paar Stunden dauern kann!
 TableLmsEnded: Beended
 TableLmsStatus: Status E-Learning
 TableLmsSuccess: Bestanden
@@ -61,10 +63,10 @@ LmsErrorNoRefreshElearning: Fehler: E-Learning wird nicht automatisch gestartet,
 MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
 MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
 MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
-MailBodyQualificationRenewal qname@Text: Sie müssen Qualifikation #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang.
+MailBodyQualificationRenewal qname@Text: Sie müssen die Qualifikation #{qname} demnächst durch einen E-Learning Kurs erneuern, siehe Anhang.
 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.
-LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort hinterlegt wurde, ist das PDF-Passwort Ihre Fraport Ausweisnummer, inklusive Punkt und der Ziffer danach.
+LmsRenewalInstructions: Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF dem von Ihnen in FRADrive hinterlegten PDF-Passwort verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort Ihre Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
 LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Learning verlängert werden.
 LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden
 LmsActRenewPin: Neue zufällige E-Learning PIN zuweisen
@@ -86,4 +88,4 @@ 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
-BtnLmsDequeue: Nutzer mit beendetem E-Learning ggf. benachrichtigen und aufräumen 
+BtnLmsDequeue: Nutzer mit beendetem E-Learning ggf. benachrichtigen und aufräumen 

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

@@ -21,9 +21,10 @@ LmsQualificationValidUntil: Valid until
 TableQualificationLastRefresh: Last renewed
 TableQualificationFirstHeld: First held
 TableQualificationBlockedDue: Suspended
-TableQualificationBlockedTooltip: When was the qualification temporarily suspended and who requested this?
+TableQualificationBlockedTooltip: Why and when was this qualification temporarily suspended?
 TableQualificationNoRenewal: Canceled
 TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
+QualificationUserNoRenewal: Expires without further notification
 LmsUser: Licensee
 TableLmsEmail: Email
 TableLmsIdent: LMS Identifier
@@ -36,6 +37,7 @@ TableLmsStaff: Staff?
 TableLmsStarted: Started
 TableLmsReceived: Last update
 TableLmsNotified: Notification sent
+TableLmsNotifiedTooltip: Notfications are not sent before the LMS acknowledges the opening of the e-learning course for the user, which may take several hours!
 TableLmsEnded: Ended
 TableLmsStatus: Status e-learning
 TableLmsSuccess: Completed
@@ -86,4 +88,4 @@ 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.
-BtnLmsDequeue: Dequeue users with finished e-learning and notify, if appropriate.
+BtnLmsDequeue: Dequeue users with finished e-learning and notify, if appropriate.

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -30,6 +30,7 @@ MenuLogout !ident-ok: Logout
 MenuCourseList: Kurse
 MenuCourseMembers: Kursteilnehmer:innen
 MenuCourseAddMembers: Kursteilnehmer:innen hinzufügen
+MenuTutorialAddMembers: Tutorium Teilnehmer:innen hinzufügen
 MenuCourseCommunication: Kursmitteilung (E-Mail)
 MenuCourseExamOffice: Prüfungsbeauftragte
 MenuTermShow: Semester

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -29,7 +29,8 @@ MenuLogin: Login
 MenuLogout: Logout
 MenuCourseList: Courses
 MenuCourseMembers: Participants
-MenuCourseAddMembers: Add participants
+MenuCourseAddMembers: Add course participants
+MenuTutorialAddMembers: Add tutorium participants
 MenuCourseCommunication: Course message (email)
 MenuCourseExamOffice: Exam offices
 MenuTermShow: Semesters

models/users.model

@@ -88,7 +88,8 @@ UserGroupMember
 UserCompany 
     user                  UserId  
     company               CompanyId  OnDeleteCascade OnUpdateCascade
-    supervisor            Bool       -- is this user a company supervisor?    
+    supervisor            Bool       -- should this user be made supervisor for all _new_ users associated with this company?        
+    supervisorReroute     Bool       default=true -- if supervisor is true, should this supervisor receive email for _new_ company users?
     UniqueUserCompany user company   -- a user may belong to multiple companies, but to each one only once
     deriving Generic
 UserSupervisor

nix/docker/demo-version.json

@@ -1,3 +1,3 @@
 {
-  "version": "27.0.18"
+  "version": "27.0.19"
 }

nix/docker/version.json

@@ -1,3 +1,3 @@
 {
-  "version": "27.0.18"
+  "version": "27.0.19"
 }

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "27.0.18",
+  "version": "27.0.19",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "27.0.18",
+  "version": "27.0.19",
   "description": "",
   "keywords": [],
   "author": "",

package.yaml

@@ -1,5 +1,5 @@
 name: uniworx
-version: 27.0.18
+version: 27.0.19
 dependencies:
   - base
   - yesod

routes

@@ -209,6 +209,7 @@
     /edit                     TEditR           GET POST        !tutorANDtutor-control
     /delete                   TDeleteR         GET POST
     /participants             TUsersR          GET POST        !tutor
+    /participants/add         TAddUserR        GET POST        !tutor
     /register                 TRegisterR           POST        !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered
     /communication            TCommR           GET POST        !tutor
     /tutor-invite             TInviteR         GET POST        !tutorANDtutor-control

src/Audit/Types.hs

@@ -199,10 +199,11 @@ data Transaction
     }
 
   | TransactionQualificationUserEdit
-    { transactionQualificationUser :: QualificationUserId
+    { transactionQualificationUser            :: QualificationUserId
-    , transactionQualification     :: QualificationId
+    , transactionQualification                :: QualificationId
-    , transactionUser              :: UserId
+    , transactionUser                         :: UserId
-    , transactionQualificationValidUntil :: Day
+    , transactionQualificationValidUntil      :: Day
+    , transactionQualificationScheduleRenewal :: Maybe Bool -- Maybe, because some update may leave it unchanged (also avoids DB Migration)
     }
   | TransactionQualificationUserDelete
     { transactionQualificationUser :: QualificationUserId

src/Foundation/Navigation.hs

@@ -283,11 +283,12 @@ breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
   TUsersR  -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
     guardM . lift . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
     return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
-  TEditR   -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
+  TAddUserR   -> i18nCrumb MsgMenuTutorialAddMembers      . Just $ CTutorialR tid ssh csh tutn TUsersR 
-  TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
+  TEditR      -> i18nCrumb MsgMenuTutorialEdit            . Just $ CTutorialR tid ssh csh tutn TUsersR
-  TCommR   -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR
+  TDeleteR    -> i18nCrumb MsgMenuTutorialDelete          . Just $ CTutorialR tid ssh csh tutn TUsersR
-  TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR
+  TCommR      -> i18nCrumb MsgMenuTutorialComm            . Just $ CTutorialR tid ssh csh tutn TUsersR
-  TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR
+  TRegisterR  -> i18nCrumb MsgBreadcrumbTutorialRegister  . Just $ CourseR tid ssh csh CShowR
+  TInviteR    -> i18nCrumb MsgBreadcrumbTutorInvite       . Just $ CTutorialR tid ssh csh tutn TUsersR
 
 breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
   SShowR -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do
@@ -1631,6 +1632,17 @@ pageActions (CTutorialR tid ssh csh tutn TUsersR) = do
   membersSecondary <- pageQuickActions NavQuickViewPageActionSecondary $ CourseR tid ssh csh CUsersR
   return
     [ NavPageActionPrimary
+      { navLink = NavLink
+        { navLabel       = MsgMenuTutorialAddMembers
+        , navRoute       = CTutorialR tid ssh csh tutn TAddUserR
+        , navAccess'     = NavAccessTrue
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      , navChildren = []
+      }
+    , NavPageActionPrimary
       { navLink = NavLink
         { navLabel       = MsgMenuCourseMembers
         , navRoute       = CourseR tid ssh csh CUsersR

src/Foundation/Yesod/Auth.hs

@@ -182,7 +182,8 @@ upsertCampusUser upsertMode ldapData = do
   userDefaultConf <- getsYesod $ view _appUserDefaults
 
   (newUser,userUpdate) <- decodeUser now userDefaultConf upsertMode ldapData
-  
+  --TODO: newUser should be associated with a company and company supervisor through Handler.Utils.Company.upsertUserCompany, but this is called by upsertAvsUser already - conflict?
+
   oldUsers <- for (userLdapPrimaryKey newUser) $ \pKey -> selectKeysList [ UserLdapPrimaryKey ==. Just pKey ] []
 
   user@(Entity userId userRec) <- case oldUsers of

src/Handler/Admin.hs

@@ -146,6 +146,7 @@ retrieveUnreachableUsers :: E.SqlQuery (E.SqlExpr (Entity User))
 retrieveUnreachableUsers = do     
     user <- E.from $ E.table @User
     E.where_ $  E.isNothing (user E.^. UserPostAddress)
+          E.&&. E.isNothing (user E.^. UserCompanyDepartment)
           E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%") 
     return user 
 
@@ -225,4 +226,4 @@ retrieveDriversRWithoutF nowaday = do
   
 {-
 getAdjustLicences :: SchoolId -> QualificationShortand -> Handler Html
--}
+-}

src/Handler/Admin/Avs.hs

@@ -333,8 +333,9 @@ embedRenderMessage ''UniWorX ''LicenceTableAction id
 
 data LicenceTableActionData =  LicenceTableChangeAvsData
                             |  LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later
-                            |  LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
+                            |  LicenceTableGrantFDriveData { licenceTableChangeFDriveQId    :: QualificationId
-                                                           , licenceTableChangeFDriveEnd :: Day
+                                                           , licenceTableChangeFDriveEnd    :: Day
+                                                           , licenceTableChangeFDriveRenew  :: Maybe Bool
                                                            }
   deriving (Eq, Ord, Read, Show, Generic)
 
@@ -423,7 +424,7 @@ getProblemAvsSynchR = do
         nups <- runDB $ do
           qId <- getKeyBy404 $ UniqueQualificationAvsLicence $ Just alic
           selectedUsers <- view _userAvsUser <<$>> selectList [UserAvsPersonId <-. Set.toList apids] []
-          forM_ selectedUsers $ upsertQualificationUser qId nowaday $ pred nowaday
+          forM_ selectedUsers $ upsertQualificationUser qId nowaday (pred nowaday) Nothing
           return $ length selectedUsers
         addMessageI Success $ MsgRevokeFraDriveLicences alic nups
         redirect ProblemAvsSynchR -- must be outside runDB 
@@ -433,7 +434,7 @@ getProblemAvsSynchR = do
           uas <- selectList [UserAvsPersonId <-. Set.toList apids] []
           let uids = view _userAvsUser <$> uas
           -- addMessage Info $ text2Html $ "UIDs: " <> tshow uids -- DEBUG
-          forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd
+          forM_ uids $ upsertQualificationUser licenceTableChangeFDriveQId nowaday licenceTableChangeFDriveEnd licenceTableChangeFDriveRenew
           (length uids,) <$> get404 licenceTableChangeFDriveQId
         addMessageI Success $ MsgSetFraDriveLicences (citext2string qualificationShorthand) n
         redirect ProblemAvsSynchR -- must be outside runDB 
@@ -577,6 +578,7 @@ mkLicenceTable PaginationParameters{..} dbtIdent aLic apids = do
               else singletonMap LicenceTableGrantFDrive  $ LicenceTableGrantFDriveData 
                     <$> apreq (selectField . fmap mkOptionList $ mapM qualOpt avsQualifications) (fslI MsgQualificationName) aLicQid
                     <*> apreq dayField (fslI MsgLmsQualificationValidUntil) Nothing -- apreq?!
+                    <*> aopt (convertField not not (boolField . Just $ SomeMessage MsgBoolIrrelevant)) (fslI MsgQualificationUserNoRenewal) Nothing
           ]      
       dbtParams = DBParamsForm
           { dbParamsFormMethod = POST

src/Handler/Course/ParticipantInvite.hs

@@ -4,6 +4,7 @@
 
 module Handler.Course.ParticipantInvite
   ( getCAddUserR, postCAddUserR
+  , getTAddUserR, postTAddUserR
   ) where
 
 import Import
@@ -116,9 +117,16 @@ instance Monoid AddParticipantsResult where
   mappend = (<>)
 
 
-getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getCAddUserR,  postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCAddUserR = postCAddUserR
-postCAddUserR tid ssh csh = do
+postCAddUserR tid ssh csh = do 
+  today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
+  postTAddUserR tid ssh csh (CI.mk $ tshow today)  -- Don't use user date display setting, so that tutorial default names conform to all users
+
+
+getTAddUserR,  postTAddUserR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler Html
+getTAddUserR = postTAddUserR
+postTAddUserR tid ssh csh tut = do
   cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
   currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute
 
@@ -141,11 +149,10 @@ postCAddUserR tid ssh csh = do
       | otherwise
         -> redirect $ CourseR tid ssh csh CUsersR
 
-  ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
+  ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do    
-    today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
+    auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
-    auReqUsers <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
     auReqTutorial <- optionalActionW
-      ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just . CI.mk $ tshow today) ) -- TODO: use user date display setting
+      ( areq (textField & cfCI) (fslI MsgCourseParticipantsRegisterTutorialField & setTooltip MsgCourseParticipantsRegisterTutorialFieldTip) (Just tut) ) 
       ( fslI MsgCourseParticipantsRegisterTutorialOption )
       ( Just True )
     return $ AddUserRequest <$> auReqUsers <*> auReqTutorial

src/Handler/LMS.hs

@@ -534,7 +534,7 @@ postLmsLSR sid qsh nlimit noffset
           , sortable (Just "lms-datepin")   (i18nLms MsgTableLmsDatePin)  $ \(preview $ resultLmsUser  . _entityVal . _lmsUserDatePin  -> d) -> foldMap dateTimeCell        d
           , sortable (Just "lms-received")  (i18nLms MsgTableLmsReceived) $ \(preview $ resultLmsUser  . _entityVal . _lmsUserReceived -> d) -> foldMap dateTimeCell $ join d
           --, sortable (Just "lms-notified")  (i18nLms MsgTableLmsNotified) $ \(preview $ resultLmsUser  . _entityVal . _lmsUserNotified -> d) -> foldMap dateTimeCell $ join d
-          , sortable (Just "lms-notified")  (i18nLms MsgTableLmsNotified) $ \row ->
+          , sortable (Just "lms-notified")  (i18nLms MsgTableLmsNotified & cellTooltip MsgTableLmsNotifiedTooltip) $ \row ->
               -- 4 Cases:
               --   - No notification: LmsUserNotified == Nothing
               --   - Email sent     : LmsUserNotified == Just _  && PrintJobId == Nothing

src/Handler/SAP.hs

@@ -53,10 +53,11 @@ instance ToNamedRecord SapUserTableCsv where
     , "Ausprägung"      Csv..= csvSUTausprägung   
     ]
 
--- | Removes all elements containing Nothing, which should not be returend by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted)
+-- | Removes all personalNummer which are not numbers (i.e. excludes E-Accounts), which should not be returned by the query anyway (only qualfications with sap id and users with internal personnel number must be transmitted)
 --   TODO: once temporary suspensions are implemented, a user must be transmitted to SAP in two rows: firstheld->suspensionFrom & suspensionTo->validTo
 sapRes2csv :: [(Ex.Value (Maybe Text), Ex.Value Day, Ex.Value Day, Ex.Value (Maybe Text))] -> [SapUserTableCsv]
 sapRes2csv l = [ res | (Ex.Value (Just persNo), Ex.Value firstHeld, Ex.Value validUntil, Ex.Value (Just sapId)) <- l 
+               , readMay persNo > Just (0::Int)       -- filter E-accounts for SAP export
                , let res = SapUserTableCsv
                             { csvSUTpersonalNummer = persNo
                             , csvSUTqualifikation  = sapId
@@ -101,4 +102,4 @@ getQualificationSAPDirectR = do
   csvRenderedToTypedContentWith csvOpts csvSheetName csvRendered  
 
 -- direct Download see:
--- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod
+-- https://ersocon.net/blog/2017/2/22/creating-csv-files-in-yesod

src/Handler/Tutorial/Users.hs

@@ -100,7 +100,7 @@ postTUsersR tid ssh csh tutn = do
     (TutorialUserGrantQualificationData{..}, selectedUsers) -> do
       -- today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
       today <- utctDay <$> liftIO getCurrentTime
-      runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil
+      runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing
       addMessageI Success . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
       redirect $ CTutorialR tid ssh csh tutn TUsersR
     (TutorialUserSendMailData{}, selectedUsers) -> do

src/Handler/Users.hs

@@ -188,10 +188,10 @@ postUsersR = do
       acts = mconcat 
         [ singletonMap UserLdapSync      $ pure UserLdapSyncData
         , singletonMap UserAddSupervisor $ UserAddSupervisorData 
-            <$> apopt (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
+            <$> apopt (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
         , singletonMap UserSetSupervisor $ UserSetSupervisorData 
-            <$> apopt  (textField & cfCommaSeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
+            <$> apopt  (textField & cfAnySeparatedSet) (fslI MsgMppSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
             <*> apopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgMailSupervisorReroute & setTooltip MsgMailSupervisorRerouteTooltip) (Just True)
         , singletonMap UserRemoveSupervisor $ pure UserRemoveSupervisorData
         ]

src/Handler/Utils/Company.hs

@@ -12,15 +12,22 @@ import qualified Data.CaseInsensitive as CI
 import qualified Data.Char as Char
 import qualified Data.Text as Text
 
+import Database.Persist.Postgresql
 
 -- | Ensure that the given user is linked to the given company
 upsertUserCompany :: UserId -> Maybe Text -> DB ()
 upsertUserCompany uid (Just cName) | notNull cName = do 
   cid <- upsertCompany cName
   void $ upsertBy (UniqueUserCompany uid cid) 
-                  (UserCompany uid cid False) 
+                  (UserCompany uid cid False False) 
-                  []  
+                  []
-upsertUserCompany uid _ = deleteWhere [ UserCompanyUser ==. uid ] 
+  superVs <- selectList [UserCompanyCompany ==. cid, UserCompanySupervisor ==. True] []
+  upsertManyWhere [ UserSupervisor super uid reroute 
+                  | Entity{entityVal=UserCompany{userCompanyUser=super, userCompanySupervisorReroute=reroute, userCompanySupervisor=True}} <- superVs
+                  ] [] [] []
+upsertUserCompany uid _ = 
+  deleteWhere [ UserCompanyUser ==. uid ]     -- maybe also delete company supervisors?
+
 
 upsertCompany :: Text -> DB CompanyId
 upsertCompany cName = 

src/Handler/Utils/LMS.hs

@@ -150,4 +150,4 @@ randomLMSIdentBut banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk
 randomLMSpw :: MonadIO m => m Text
 randomLMSpw = randomText extra lengthPassword
   where
-    extra = "-+*.:;=!?#$"
+    extra = "+*:=!?#" -- you cannot distinguish ;: and ., in printed letters

src/Handler/Utils/Qualification.hs

@@ -11,23 +11,27 @@ module Handler.Utils.Qualification
 import Import
 
 
-upsertQualificationUser :: QualificationId -> Day -> Day -> UserId -> DB ()
+upsertQualificationUser :: QualificationId -> Day -> Day -> Maybe Bool -> UserId -> DB ()
-upsertQualificationUser  qualificationUserQualification today qualificationUserValidUntil qualificationUserUser = do   
+upsertQualificationUser  qualificationUserQualification qualificationUserLastRefresh qualificationUserValidUntil mbScheduleRenewal qualificationUserUser = do   
   Entity quid _ <- upsert
     QualificationUser
-      { qualificationUserLastRefresh      = today
+      { qualificationUserFirstHeld        = qualificationUserLastRefresh
-      , qualificationUserFirstHeld        = today
       , qualificationUserBlockedDue       = Nothing
-      , qualificationUserScheduleRenewal  = True
+      , qualificationUserScheduleRenewal  = fromMaybe True mbScheduleRenewal
       , ..
       }
-    [ QualificationUserValidUntil    =. qualificationUserValidUntil
+    ( 
-    , QualificationUserLastRefresh   =. today
+      [ QualificationUserScheduleRenewal    =. scheduleRenewal              | Just scheduleRenewal <- [mbScheduleRenewal]
-    , QualificationUserBlockedDue    =. Nothing
+      ] ++
-    ]
+      [ QualificationUserValidUntil         =. qualificationUserValidUntil
+      , QualificationUserLastRefresh        =. qualificationUserLastRefresh
+      , QualificationUserBlockedDue         =. Nothing
+      ]
+    )    
   audit TransactionQualificationUserEdit
     { transactionQualificationUser        = quid
     , transactionQualification            = qualificationUserQualification
     , transactionUser                     = qualificationUserUser
     , transactionQualificationValidUntil  = qualificationUserValidUntil
+    , transactionQualificationScheduleRenewal = mbScheduleRenewal
     }

src/Handler/Utils/Users.hs

@@ -59,11 +59,11 @@ abbrvName User{userDisplayName, userFirstName, userSurname} =
     assemble = Text.intercalate "."
 
 
--- deprecated, used getPostalAddressIfPreferred
+-- deprecated, used getPostalPreferenceAndAddress
 userPrefersLetter :: User -> Bool
 userPrefersLetter = fst . getPostalPreferenceAndAddress
 
--- deprecated, used getPostalAddressIfPreferred
+-- deprecated, used getPostalPreferenceAndAddress
 userPrefersEmail :: User -> Bool
 userPrefersEmail = not . userPrefersLetter
 
@@ -821,7 +821,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
       return $ UserSupervisor
         E.<#  E.val newUserId
         E.<&> (userSupervisor E.^. UserSupervisorUser)
-        E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications)
+        E.<&> (userSupervisor E.^. UserSupervisorRerouteNotifications)        
     )
     (\current excluded -> [ UserSupervisorRerouteNotifications E.=. (current E.^. UserSupervisorRerouteNotifications E.||. excluded E.^. UserSupervisorRerouteNotifications)  ] )
   deleteWhere [ UserSupervisorSupervisor ==. oldUserId]
@@ -847,6 +847,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
         E.<#  E.val newUserId
         E.<&> (userCompany E.^. UserCompanyCompany)
         E.<&> (userCompany E.^. UserCompanySupervisor)
+        E.<&> (userCompany E.^. UserCompanySupervisorReroute)
     )
     (\current _excluded -> [ UserCompanySupervisor E.=. (current E.^. UserCompanySupervisor)] )
   deleteWhere [ UserCompanyUser ==. oldUserId]

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -73,16 +73,18 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do
     <*> getBy (UniqueQualificationUser    nQualification jRecipient)
     <*> getBy (UniqueLmsQualificationUser nQualification jRecipient)
   case query of 
-    (Just User{userDisplayName}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
+    (Just User{userDisplayName, userSurname}, Just Qualification{..}, Just (Entity _ QualificationUser{..}), Just(Entity luid LmsUser{..})) -> do
       let qname = CI.original qualificationName
       let letter = LetterRenewQualificationF
             { lmsLogin     = lmsUserIdent
             , lmsPin       = lmsUserPin
             , qualHolder   = userDisplayName 
+            , qualHolderSN = userSurname
             , qualExpiry   = qualificationUserValidUntil
-            , qualId       = nQualification
+            , qualId       = nQualification            
             , qualName     = qname
             , qualShort    = CI.original qualificationShorthand                                
+            , qualSchool   = qualificationSchool            
             , qualDuration = qualificationValidDuration
             }
       $logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname

src/Model/Types/Mail.hs

@@ -81,6 +81,18 @@ instance Default NotificationSettings where
       defaultOff = HashSet.fromList
         [ NTSheetSoonInactive
         , NTExamRegistrationSoonInactive
+        , NTSubmissionRated
+        , NTSubmissionEdited
+        , NTSubmissionUserCreated
+        , NTSubmissionUserDeleted
+        , NTSheetActive
+        , NTSheetHint
+        , NTSheetSolution
+        , NTSheetInactive
+        , NTCorrectionsAssigned
+        , NTCorrectionsNotDistributed
+        , NTUserAuthModeUpdate
+        , NTCourseRegistered
         ]
 
 instance ToJSON NotificationSettings where

src/Utils/Form.hs

@@ -22,6 +22,7 @@ import Utils.Lens
 import Text.Blaze (Markup)
 import qualified Text.Blaze.Internal as Blaze (null)
 import qualified Data.Text as T
+import qualified Data.Char as C
 
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@@ -849,6 +850,17 @@ cfCI = convertField CI.mk CI.original
 cfCommaSeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
 cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.splitOn ",") (T.intercalate ", " . Set.toList)
 
+cfAnySeparatedSet :: (Functor m) => Field m Text -> Field m (Set Text)
+cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", " . Set.toList)
+  where anySeparator :: Char -> Bool
+        anySeparator c = C.isSeparator c || c == ',' || c == ';'
+
+-- -- TODO: consider using package ordered-containers?
+-- cfAnySeparatedList :: (Functor m) => Field m Text -> Field m [Text]
+-- cfAnySeparatedList = guardField (not . null) . convertField (mapMaybe (assertM' (not . T.null) . T.strip) . T.split anySeparator) (T.intercalate ", ")
+--   where anySeparator :: Char -> Bool
+--         anySeparator c = C.isSeparator c || c == ',' || c == ';'
+
 isoField :: Functor m => AnIso' a b -> Field m a -> Field m b
 isoField (cloneIso -> fieldIso) = convertField (view fieldIso) (review fieldIso)
 

src/Utils/Print.hs

@@ -42,7 +42,7 @@ import System.Process.Typed -- for calling pdftk for pdf encryption
 import Handler.Utils.Users
 import Handler.Utils.DateTime
 import Handler.Utils.Mail
-import Handler.Utils.Widgets (nameHtml')
+import Handler.Utils.Widgets (nameHtml, nameHtml')
 import Handler.Utils.Avs (updateReceivers)
 import Jobs.Handler.SendNotification.Utils
 
@@ -368,28 +368,47 @@ convertProto f (IsTime t) = P.toMetaValue $ f t
 
 class MDLetter l where
   getTemplate     :: Proxy l -> Text
-  getMailSubject  :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
+  getMailSubject  :: l -> SomeMessage UniWorX                                                     -- only used if letter is sent by email as pdf attachment
-  getMailBody     :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
+  getMailBody     :: l -> DateTimeFormatter -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)  -- only used if letter is sent by email as pdf attachment
-  letterMeta      :: l -> Lang -> DateTimeFormatter -> P.Meta
+  letterMeta      :: l -> DateTimeFormatter -> Lang -> P.Meta
   getPJId         :: l -> PrintJobIdentification
 
 data LetterRenewQualificationF = LetterRenewQualificationF
     { lmsLogin      :: LmsIdent
     , lmsPin        :: Text
     , qualHolder    :: UserDisplayName
+    , qualHolderSN  :: UserSurname
     , qualExpiry    :: Day
     , qualId        :: QualificationId
     , qualName      :: Text
     , qualShort     :: Text
+    , qualSchool    :: SchoolId
     , qualDuration  :: Maybe Int
     }
   deriving (Eq, Show)
 
+-- this type is specific to this letter to avoid code duplication for derived data or constants
+data LetterRenewQualificationFData = LetterRenewQualificationFData { lmsUrl, lmsUrlLogin, lmsIdent :: Text } 
+  deriving (Eq, Show)
+
+letterRenewalQualificationFData :: LetterRenewQualificationF -> LetterRenewQualificationFData
+letterRenewalQualificationFData LetterRenewQualificationF{lmsLogin} = LetterRenewQualificationFData{..}
+  where 
+    lmsUrl      = "https://drive.fraport.de"
+    lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent
+    lmsIdent    = getLmsIdent lmsLogin    
+ 
 instance MDLetter LetterRenewQualificationF where
   getTemplate     _ = templateRenewal
   getMailSubject  l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
-  getMailBody     l = SomeMessage $ MsgMailBodyQualificationRenewal    $ qualName  l
+  -- getMailBody     l = SomeMessage $ MsgMailBodyQualificationRenewal    $ qualName  l
-  letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta
+  getMailBody l@LetterRenewQualificationF{..} DateTimeFormatter{ format } = 
+    let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l
+    in $(ihamletFile "templates/mail/body/qualificationRenewal.hamlet")
+
+  letterMeta l@LetterRenewQualificationF{..} DateTimeFormatter{ format } _lang = 
+    let LetterRenewQualificationFData{..} = letterRenewalQualificationFData l 
+    in mkMeta
       [ toMeta "login"          lmsIdent
       , toMeta "pin"            lmsPin
       , toMeta "examinee"       qualHolder
@@ -398,10 +417,7 @@ instance MDLetter LetterRenewQualificationF where
       , toMeta "url-text"       lmsUrl
       , toMeta "url"            lmsUrlLogin
       ]
-    where
+
-      lmsUrl      = "https://drive.fraport.de"
-      lmsUrlLogin = lmsUrl <> "/?login=" <> lmsIdent
-      lmsIdent    = getLmsIdent lmsLogin
   getPJId LetterRenewQualificationF{..} =
     PrintJobIdentification
       { pjiName             = "Renewal"
@@ -418,8 +434,7 @@ sendEmailOrLetter recipient letter = do
   let tmpl = getTemplate $ pure letter
       pjid = getPJId letter
       -- Below are only needed if sent by email
-      mailSubject = getMailSubject letter
+      mailSubject = getMailSubject letter      
-      mailBody    = getMailBody    letter
       undername = underling ^. _userDisplayName -- nameHtml' underling
       undermail = CI.original $ underling ^. _userEmail
   now <- liftIO getCurrentTime
@@ -428,7 +443,8 @@ sendEmailOrLetter recipient letter = do
     let (preferPost, postal) = getPostalPreferenceAndAddress rcvrUsr
         isSupervised = recipient /= svr
         lang  = selectDeEn $ rcvrUsr & userLanguages   -- select either German or English only, default de; see Utils.Lang
-        lMeta = letterMeta letter lang formatter <> mkMeta (                  
+        mailBody = getMailBody letter formatter
+        lMeta = letterMeta letter formatter lang <> mkMeta (                  
                   ( if isSupervised 
                     then 
                       [ toMeta "supervisor" (rcvrUsr & userDisplayName)

templates/letter/din5008.latex

@@ -138,7 +138,7 @@ $endif$
         $endif$
 
         \begin{textblock}{65}(84,232)%hpos,vpos
-            \textcolor{black!33}{ 
+            \textcolor{black!39}{ 
               \begin{labeling}{Login:x}
                 \item[Login:] $login$
                 \item[Pin:]   $pin$    

templates/letter/fraport_renewal.md

@@ -89,7 +89,7 @@ Sollte bis zum Ablaufdatum das E-Learning nicht erfolgreich abgeschlossen sein,
 zur Wiedererlangung der Fahrberechtigung "F" erneut ein Grundkurs 
 bei der Fahrerausbildung absolviert werden. 
 Bei Fragen können Sie sich gerne an das Team der Fahrerausbildung wenden. 
-(Please contact us if you prefer letters in English.)
+(Please contact us if you prefer letters in English.!)
 
 $else$
 

templates/mail/body/qualificationRenewal.hamlet

@@ -0,0 +1,25 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<p>
+  _{SomeMessage $ MsgMailBodyQualificationRenewal qualName}      
+
+<p>
+  <dl>
+    <dt>_{SomeMessage MsgQualificationName}
+    <dd>
+      <a href=@{QualificationR qualSchool (CI.mk qualShort)}>
+        #{qualName}
+    <dt>_{SomeMessage MsgLmsUser}
+    <dd>#{nameHtml qualHolder qualHolderSN}
+    <dt>_{SomeMessage MsgLmsQualificationValidUntil}
+    <dd>#{format SelFormatDate qualExpiry}
+
+<p>
+  _{SomeMessage MsgLmsRenewalInstructions} #
+
+  <a href=#{lmsUrlLogin}>
+    _{SomeMessage MsgMppURL} #{lmsUrl}

templates/mail/genericMailLetter.hamlet

@@ -18,8 +18,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
     <h1>
       _{mailSubject}
 
-    <p>
+    ^{mailBody}
-      _{mailBody}
 
     $if isSupervised
       <h2>_{SomeMessage MsgMailSupervisorNote}

test/Database/Fill.hs

@@ -28,6 +28,8 @@ import Data.List (foldl)
 import System.Directory (getModificationTime)
 import System.FilePath.Glob (glob)
 
+import Database.Persist.Postgresql
+
 {- Needed for File Tests only
 import qualified Data.Conduit.Combinators as C
 import Paths_uniworx (getDataFileName)
@@ -435,7 +437,7 @@ fillDb = do
   manyUsers <- insertMany . getZipList $ manyUser <$> ZipList ((,,) <$> firstNames <*> middlenames <*> surnames) <*> ZipList matrikel
   matUsers <- selectList [UserMatrikelnummer !=. Nothing] []
   insertMany_ [UserAvs (AvsPersonId n) uid n | Entity uid User{userMatrikelnummer = fmap readMay -> Just (Just n)} <- matUsers]
-
+  
   let tmin   = -1
       tmax   = 2
       trange = [tmin..tmax]
@@ -488,20 +490,33 @@ fillDb = do
   nice      <- insert' $ Company "N*ICE Aircraft Services & Support GmbH"              "N*ICE"      33   False Nothing
   ffacil    <- insert' $ Company "Fraport Facility Services GmbH"                      "GCS"        44   False Nothing
   bpol      <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main"  "BPol"       5555 False Nothing 
-  void . insert' $ UserCompany jost    fraportAg    True
+  void . insert' $ UserCompany jost    fraportAg    True   True 
-  void . insert' $ UserCompany svaupel nice         True
+  void . insert' $ UserCompany svaupel nice         True   False 
-  void . insert' $ UserCompany gkleen  nice         False
+  void . insert' $ UserCompany gkleen  nice         False  False 
-  void . insert' $ UserCompany gkleen  fraGround    False
+  void . insert' $ UserCompany gkleen  fraGround    False  True 
-  void . insert' $ UserCompany fhamann bpol         False
+  void . insert' $ UserCompany fhamann bpol         False  False 
-  void . insert' $ UserCompany fhamann ffacil       True
+  void . insert' $ UserCompany fhamann ffacil       True   True 
-  void . insert' $ UserCompany fhamann nice         False
+  void . insert' $ UserCompany fhamann nice         False  False
-  void . insert' $ UserSupervisor jost gkleen       True
+  -- void . insert' $ UserSupervisor jost gkleen       True
-  void . insert' $ UserSupervisor jost svaupel      False
+  -- void . insert' $ UserSupervisor jost svaupel      False
-  void . insert' $ UserSupervisor jost sbarth       False
+  -- void . insert' $ UserSupervisor jost sbarth       False
-  void . insert' $ UserSupervisor jost tinaTester   True
+  -- void . insert' $ UserSupervisor jost tinaTester   True
-  void . insert' $ UserSupervisor svaupel gkleen    False
+  -- void . insert' $ UserSupervisor svaupel gkleen    False
-  void . insert' $ UserSupervisor svaupel fhamann   True
+  -- void . insert' $ UserSupervisor svaupel fhamann   True
-  void . insert' $ UserSupervisor sbarth tinaTester True
+  -- void . insert' $ UserSupervisor sbarth tinaTester True
+  let supvs = [ UserSupervisor jost gkleen       True
+              , UserSupervisor jost svaupel      False
+              , UserSupervisor jost sbarth       False
+              , UserSupervisor jost tinaTester   True
+              , UserSupervisor svaupel gkleen    False
+              , UserSupervisor svaupel fhamann   True
+              , UserSupervisor sbarth tinaTester True
+              , UserSupervisor gkleen fhamann    False
+              ]
+  upsertManyWhere supvs [] [] [] 
+  -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok  
+  -- insertMany_ supvs              -- NOTE: multiple calls like this throw an error!
+
   ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True) SchoolAuthorshipStatementModeOptional (Just ifiAuthorshipStatement) True SchoolAuthorshipStatementModeRequired (Just ifiAuthorshipStatement) False
   mi  <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True
   avn <- insert' $ School "Fahrerausbildung" "FA" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False) SchoolAuthorshipStatementModeNone Nothing True SchoolAuthorshipStatementModeOptional Nothing True

test/ModelSpec.hs

@@ -139,6 +139,7 @@ instance Arbitrary User where
     userCompanyDepartment <- arbitrary
     userPinPassword <- arbitrary
     userPostAddress <- arbitrary -- TODO: not a good address
+    userPostLastUpdate <- arbitrary
     userPrefersPostal <- arbitrary
     userExamOfficeGetSynced <- arbitrary
     userExamOfficeGetLabels <- arbitrary

test/User.hs

@@ -56,4 +56,5 @@ fakeUser adjUser = adjUser User{..}
     userCompanyDepartment = Nothing
     userPinPassword = Nothing
     userPostAddress = Nothing
+    userPostLastUpdate = Nothing
     userPrefersPostal = userDefaultPrefersPostal