fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into fradrive/split-lms

Browse Source
This commit is contained in:
Steffen Jost 2023-02-03 15:42:04 +01:00
commit f9b9f79a9e
41 changed files with 225 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGELOG.md
View File

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

2
messages/uniworx/categories/avs/de-de-formal.msg
View File

@ -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

2
messages/uniworx/categories/avs/en-eu.msg
View File

@ -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

2
messages/uniworx/categories/courses/courses/de-de-formal.msg
View File

@ -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.

2
messages/uniworx/categories/courses/courses/en-eu.msg
View File

@ -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.

12
messages/uniworx/categories/qualification/de-de-formal.msg
View File

@ -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

6
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -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.

1
messages/uniworx/utils/navigation/menu/de-de-formal.msg
View File

@ -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

3
messages/uniworx/utils/navigation/menu/en-eu.msg
View File

@ -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

3
models/users.model
View File

@ -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

2
nix/docker/demo-version.json
View File

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

2
nix/docker/version.json
View File

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

2
package-lock.json generated
View File

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

2
package.json
View File

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

2
package.yaml
View File

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

1
routes
View File

@ -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

9
src/Audit/Types.hs
View File

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

22
src/Foundation/Navigation.hs
View File

@ -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
TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
TCommR -> i18nCrumb MsgMenuTutorialComm . 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
TAddUserR -> i18nCrumb MsgMenuTutorialAddMembers . Just $ CTutorialR tid ssh csh tutn TUsersR
TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
TCommR -> i18nCrumb MsgMenuTutorialComm . 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

3
src/Foundation/Yesod/Auth.hs
View File

@ -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

3
src/Handler/Admin.hs
View File

@ -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
-}
-}

10
src/Handler/Admin/Avs.hs
View File

@ -333,8 +333,9 @@ embedRenderMessage ''UniWorX ''LicenceTableAction id
data LicenceTableActionData = LicenceTableChangeAvsData
| LicenceTableRevokeFDriveData --TODO: add { licenceTableChangeFDriveQId :: QualificationId to avoid lookup later
| LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
, licenceTableChangeFDriveEnd :: Day
| LicenceTableGrantFDriveData { licenceTableChangeFDriveQId :: QualificationId
, 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

19
src/Handler/Course/ParticipantInvite.hs
View File

@ -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
today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
auReqUsers <- wreq (textField & cfCommaSeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty
((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do
auReqUsers <- wreq (textField & cfAnySeparatedSet) (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

2
src/Handler/LMS.hs
View File

@ -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

5
src/Handler/SAP.hs
View File

@ -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

2
src/Handler/Tutorial/Users.hs
View File

@ -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

4
src/Handler/Users.hs
View File

@ -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
]

13
src/Handler/Utils/Company.hs
View File

@ -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)
[]
upsertUserCompany uid _ = deleteWhere [ UserCompanyUser ==. uid ]
(UserCompany uid cid False False)
[]
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 =

2
src/Handler/Utils/LMS.hs
View File

@ -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

22
src/Handler/Utils/Qualification.hs
View File

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

7
src/Handler/Utils/Users.hs
View File

@ -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]

6
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -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

12
src/Model/Types/Mail.hs
View File

@ -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

12
src/Utils/Form.hs
View File

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

42
src/Utils/Print.hs
View File

@ -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
getMailBody :: l -> SomeMessage UniWorX -- only used if letter is sent by email as pdf attachment
letterMeta :: l -> Lang -> DateTimeFormatter -> P.Meta
getMailSubject :: 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 -> 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
letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta
-- getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l
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
mailBody = getMailBody letter
mailSubject = getMailSubject 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)

2
templates/letter/din5008.latex
View File

@ -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$

2
templates/letter/fraport_renewal.md
View File

@ -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$

25
templates/mail/body/qualificationRenewal.hamlet Normal file
View File

@ -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}

3
templates/mail/genericMailLetter.hamlet
View File

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

45
test/Database/Fill.hs
View File

@ -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 svaupel nice True
void . insert' $ UserCompany gkleen nice False
void . insert' $ UserCompany gkleen fraGround False
void . insert' $ UserCompany fhamann bpol False
void . insert' $ UserCompany fhamann ffacil True
void . insert' $ UserCompany fhamann nice False
void . insert' $ UserSupervisor jost gkleen True
void . insert' $ UserSupervisor jost svaupel False
void . insert' $ UserSupervisor jost sbarth False
void . insert' $ UserSupervisor jost tinaTester True
void . insert' $ UserSupervisor svaupel gkleen False
void . insert' $ UserSupervisor svaupel fhamann True
void . insert' $ UserSupervisor sbarth tinaTester True
void . insert' $ UserCompany jost fraportAg True True
void . insert' $ UserCompany svaupel nice True False
void . insert' $ UserCompany gkleen nice False False
void . insert' $ UserCompany gkleen fraGround False True
void . insert' $ UserCompany fhamann bpol False False
void . insert' $ UserCompany fhamann ffacil True True
void . insert' $ UserCompany fhamann nice False False
-- void . insert' $ UserSupervisor jost gkleen True
-- void . insert' $ UserSupervisor jost svaupel False
-- void . insert' $ UserSupervisor jost sbarth False
-- void . insert' $ UserSupervisor jost tinaTester True
-- void . insert' $ UserSupervisor svaupel gkleen False
-- void . insert' $ UserSupervisor svaupel fhamann 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

1
test/ModelSpec.hs
View File

@ -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

1
test/User.hs
View File

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