Merge remote-tracking branch 'origin/fradrive/localmaster'
This commit is contained in:
Steffen Jost
commit
e1b2c8a17e
@ -1,7 +1,7 @@
|
|||||||
# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||||
#
|
#
|
||||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
AvsPersonInfo: AVS Personendaten
|
||||||
AvsPersonId: AVS Personen Id
|
AvsPersonId: AVS Personen Id
|
||||||
AvsPersonNo: AVS Personennummer
|
AvsPersonNo: AVS Personennummer
|
||||||
AvsCardNo: Ausweiskartennummer
|
AvsCardNo: Ausweiskartennummer
|
||||||
@ -29,4 +29,9 @@ RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer
|
|||||||
AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
|
AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
|
||||||
LicenceTableChangeAvs: Im AVS ändern
|
LicenceTableChangeAvs: Im AVS ändern
|
||||||
LicenceTableGrantFDrive: In FRADrive erteilen
|
LicenceTableGrantFDrive: In FRADrive erteilen
|
||||||
LicenceTableRevokeFDrive: In FRADrive entziehen
|
LicenceTableRevokeFDrive: In FRADrive entziehen
|
||||||
|
TableAvsActiveCards: Gültige Ausweise
|
||||||
|
AvsCardColorGreen: Grün
|
||||||
|
AvsCardColorBlue: Blau
|
||||||
|
AvsCardColorRed: Rot
|
||||||
|
AvsCardColorYellow: Gelb
|
||||||
@ -1,7 +1,7 @@
|
|||||||
# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||||
#
|
#
|
||||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
AvsPersonInfo: AVS Person Info
|
||||||
AvsPersonId: AVS Person Id
|
AvsPersonId: AVS Person Id
|
||||||
AvsPersonNo: AVS Person Number
|
AvsPersonNo: AVS Person Number
|
||||||
AvsCardNo: Card number
|
AvsCardNo: Card number
|
||||||
@ -30,3 +30,8 @@ AvsCommunicationError: AVS interface returned an unexpected error.
|
|||||||
LicenceTableChangeAvs: Change in AVS
|
LicenceTableChangeAvs: Change in AVS
|
||||||
LicenceTableGrantFDrive: Grant in FRADrive
|
LicenceTableGrantFDrive: Grant in FRADrive
|
||||||
LicenceTableRevokeFDrive: Revoke in FRADrive
|
LicenceTableRevokeFDrive: Revoke in FRADrive
|
||||||
|
TableAvsActiveCards: Valid Cards
|
||||||
|
AvsCardColorGreen: Green
|
||||||
|
AvsCardColorBlue: Blue
|
||||||
|
AvsCardColorRed: Red
|
||||||
|
AvsCardColorYellow: Yellow
|
||||||
@ -20,5 +20,5 @@ PrintCourse: Kurse
|
|||||||
PrintQualification: Qualifikation
|
PrintQualification: Qualifikation
|
||||||
PrintPDF !ident-ok: PDF
|
PrintPDF !ident-ok: PDF
|
||||||
PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
|
PrintManualRenewal: Vorfeldführerschein Renewal-Brief testweise versenden
|
||||||
PrintLmsUser: E-Learning Id
|
PrintLmsUser: E‑Learning Id
|
||||||
PrintJobs: Druckaufräge
|
PrintJobs: Druckaufräge
|
||||||
@ -20,5 +20,5 @@ PrintCourse: Course
|
|||||||
PrintQualification: Qualification
|
PrintQualification: Qualification
|
||||||
PrintPDF: PDF
|
PrintPDF: PDF
|
||||||
PrintManualRenewal: Manual sending of an apron driver's licence renewal letter
|
PrintManualRenewal: Manual sending of an apron driver's licence renewal letter
|
||||||
PrintLmsUser: E-learning id
|
PrintLmsUser: E‑learning id
|
||||||
PrintJobs: Print jobs
|
PrintJobs: Print jobs
|
||||||
@ -8,8 +8,8 @@ QualificationDescription: Beschreibung
|
|||||||
QualificationValidDuration: Gültigkeitsdauer
|
QualificationValidDuration: Gültigkeitsdauer
|
||||||
QualificationAuditDuration: Aufbewahrung Audit Log
|
QualificationAuditDuration: Aufbewahrung Audit Log
|
||||||
QualificationRefreshWithin: Erneurerungszeitraum
|
QualificationRefreshWithin: Erneurerungszeitraum
|
||||||
QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E-Learning
|
QualificationRefreshWithinTooltip: Zeitraum für Versand einer Benachrichtigung oder für automatischen Start des E‑Learning
|
||||||
QualificationElearningStart: Wird das E-Learning automatisch gestartet?
|
QualificationElearningStart: Wird das E‑Learning automatisch gestartet?
|
||||||
TableQualificationCountActive: Aktive
|
TableQualificationCountActive: Aktive
|
||||||
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
|
TableQualificationCountActiveTooltip: Anzahl Personen mit momentan gültiger Qualifikation
|
||||||
TableQualificationCountTotal: Gesamt
|
TableQualificationCountTotal: Gesamt
|
||||||
@ -29,7 +29,7 @@ QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
|
|||||||
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
|
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
|
||||||
QualificationBlockReason: Entzugsbegründung
|
QualificationBlockReason: Entzugsbegründung
|
||||||
LmsUser: Inhaber
|
LmsUser: Inhaber
|
||||||
LmsURL: Link E-Learning
|
LmsURL: Link E‑Learning
|
||||||
TableLmsEmail: E‑Mail
|
TableLmsEmail: E‑Mail
|
||||||
TableLmsIdent: LMS Identifikation
|
TableLmsIdent: LMS Identifikation
|
||||||
TableLmsElearning: E‑Learning
|
TableLmsElearning: E‑Learning
|
||||||
@ -41,20 +41,25 @@ TableLmsStaff: Interner Mitarbeiter?
|
|||||||
TableLmsStarted: Begonnen
|
TableLmsStarted: Begonnen
|
||||||
TableLmsReceived: Letzte Rückmeldung
|
TableLmsReceived: Letzte Rückmeldung
|
||||||
TableLmsNotified: Versand Benachrichtigung
|
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!
|
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
|
TableLmsEnded: Beended
|
||||||
TableLmsStatus: Status E‑Learning
|
TableLmsStatus: Status E‑Learning
|
||||||
TableLmsStatusTooltip mbMonth@(Maybe Int): Zeigt an, seit wann ein E-Learning offen ist oder wann es mit Bestanden oder Durchgefalen abgeschlossen wurde. #{maybeToMessage "Anzeige erlischt " (fmap (flip pluralDEeN "Monat") mbMonth) " nach Abschluss."}
|
TableLmsStatusTooltip mbMonth@(Maybe Int): Zeigt #{maybeToMessage "bis zu " (fmap (flip pluralDEeN "Monat") mbMonth) " nach Abschluss"} den letzten Zustand eines E‑Learnings an:
|
||||||
TableLmsStatusDay: Datum letzte Statusänderung E-Learning
|
TableLmsStatusDay: Datum letzte Statusänderung E‑Learning
|
||||||
TableLmsSuccess: Bestanden
|
TableLmsSuccess: Bestanden
|
||||||
TableLmsFailed: Gesperrt
|
TableLmsFailed: Gesperrt
|
||||||
|
LmsStatusBlocked: Durchgefallen wegen zu vieler Fehlversuche
|
||||||
|
LmsStatusExpired: Durchgefallen nach Fristablauf
|
||||||
|
LmsStatusSuccess: E#{nonBreakableDash}Learning bestanden
|
||||||
|
LmsStatusPlanned: E#{nonBreakableDash}Learning wird gerade eröffnet (nur für Admin sichtbar)
|
||||||
|
LmsStatusDelay: Hinweis: Statusänderung können in seltenen Fällen mehrere Stunden bis zur Anzeige benötigen.
|
||||||
FilterLmsValid: Aktuell gültig
|
FilterLmsValid: Aktuell gültig
|
||||||
FilterLmsRenewal: Erneuerung anstehend
|
FilterLmsRenewal: Erneuerung anstehend
|
||||||
FilterLmsNotified: Benachrichtigt
|
FilterLmsNotified: Benachrichtigt
|
||||||
CsvColumnLmsIdent: E-Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer
|
CsvColumnLmsIdent: E‑Learning Identifikator, einzigartig pro Qualifikation und Teilnehmer
|
||||||
CsvColumnLmsPin: PIN des E-Learning Zugangs
|
CsvColumnLmsPin: PIN des E#{nonBreakableDash}Learning Zugangs
|
||||||
CsvColumnLmsResetPin: Wird die PIN bei der nächsten Synchronisation zurückgesetzt?
|
CsvColumnLmsResetPin: Wird die PIN bei der nächsten Synchronisation zurückgesetzt?
|
||||||
CsvColumnLmsDelete: Wird der Identifikator in der E-Learning Plattform bei der nächsten Synchronisation gelöscht?
|
CsvColumnLmsDelete: Wird der Identifikator in der E‑Learning Plattform bei der nächsten Synchronisation gelöscht?
|
||||||
CsvColumnLmsStaff: Handelt es sich um einen internen Mitarbeiter? (Aus historischen Gründen, wird momentan ignoriert.)
|
CsvColumnLmsStaff: Handelt es sich um einen internen Mitarbeiter? (Aus historischen Gründen, wird momentan ignoriert.)
|
||||||
CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme (UTC)
|
CsvColumnLmsSuccess: Zeitstempel der erfolgreichen Teilnahme (UTC)
|
||||||
CsvColumnLmsFailed: User was blocked by LMS, usually due to too many attempts
|
CsvColumnLmsFailed: User was blocked by LMS, usually due to too many attempts
|
||||||
@ -65,32 +70,33 @@ LmsResultUpdate: LMS Ergebnis aktualisierung
|
|||||||
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
LmsResultCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
||||||
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
LmsUserlistCsvExceptionDuplicatedKey: CSV Import fand uneindeutigen Schlüssel
|
||||||
LmsDirectUpload: Direkter Upload für automatisierte Systeme
|
LmsDirectUpload: Direkter Upload für automatisierte Systeme
|
||||||
LmsErrorNoRefreshElearning: Fehler: E-Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
|
LmsErrorNoRefreshElearning: Fehler: E‑Learning wird nicht automatisch gestartet, da die Zeitspanne für den Erneurerungszeitraum nicht festgelegt wurde.
|
||||||
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
|
MailSubjectQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst erneuert werden
|
||||||
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
|
MailSubjectQualificationExpiry qname@Text: Qualifikation #{qname} läuft demnächst ab
|
||||||
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
|
MailSubjectQualificationExpired qname@Text: Qualifikation #{qname} ist ab sofort ungültig
|
||||||
MailBodyQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst durch einen E-Learning erneuert werden. Ansprechpartner werden gebeten, die Anmeldedaten im Anhang vertraulich an den Prüfling zu übermitteln.
|
MailBodyQualificationRenewal qname@Text: Qualifikation #{qname} muss demnächst durch einen E‑Learning erneuert werden. Ansprechpartner werden gebeten, die Anmeldedaten im Anhang vertraulich an den Prüfling zu übermitteln.
|
||||||
MailBodyQualificationExpiry: Diese Qualifikation läuft bald ab. Tätigkeiten, welche diese Qualifikation voraussetzen dürfen dann nicht länger ausgeübt werden!
|
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.
|
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.
|
||||||
QualificationActExpire: Auslaufend markieren - keine Benachrichtigung zur Erneuerung senden
|
QualificationActExpire: Auslaufend markieren - keine Benachrichtigung zur Erneuerung senden
|
||||||
QualificationActUnexpire: Auslaufend aufheben - kostenpflichtige Benachrichtigung bei anstehender Erneuerung senden
|
QualificationActUnexpire: Auslaufend aufheben - kostenpflichtige Benachrichtigung bei anstehender Erneuerung senden
|
||||||
QualificationSetExpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning abgeschaltet für #{n} #{pluralDE n "Person" "Personen"}
|
QualificationSetExpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E‑Learning abgeschaltet für #{n} #{pluralDE n "Person" "Personen"}
|
||||||
QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E-Learning aktiviert für #{n} #{pluralDE n "Person" "Personen"}
|
QualificationSetUnexpire n@Int64: Benachrichtigung bei anstehender Erneuerung und E‑Learning aktiviert für #{n} #{pluralDE n "Person" "Personen"}
|
||||||
QualificationActBlockSupervisor: Dauerhaft entziehen, mit sofortiger Wirkung
|
QualificationActBlockSupervisor: Dauerhaft entziehen, mit sofortiger Wirkung
|
||||||
QualificationActBlock: Entziehen
|
QualificationActBlock: Entziehen
|
||||||
QualificationActUnblock: Entzug löschen
|
QualificationActUnblock: Entzug löschen
|
||||||
QualificationStatusBlock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} entzogen
|
QualificationStatusBlock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} entzogen
|
||||||
QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert
|
QualificationStatusUnblock l@QualificationShorthand n@Int m@Int: #{n}/#{m} #{l} reaktiviert
|
||||||
LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
|
LmsRenewalInstructions: Weitere Anweisungen zur Verlängerung finden Sie im angehängten PDF. Um Missbrauch zu verhindern wurde das PDF mit dem im FRADrive hinterlegten PDF-Passwort des Prüflings verschlüsselt. Falls kein PDF-Passwort manuell hinterlegt wurde, ist das PDF-Passwort die Flughafen Ausweisnummer, inklusive Punkt und der Ziffer danach.
|
||||||
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E-Learning verlängert werden.
|
LmsNoRenewal: Leider kann diese Qualifikation nicht alleine durch E‑Learning verlängert werden.
|
||||||
LmsActNotify: Benachrichtigung E-Learning erneut per Post oder E-Mail versenden
|
LmsActNotify: Benachrichtigung E‑Learning erneut per Post oder E-Mail versenden
|
||||||
LmsActRenewPin: Neue zufällige E-Learning PIN zuweisen
|
LmsActRenewPin: Neue zufällige E‑Learning PIN zuweisen
|
||||||
LmsActRenewNotify: Neue zufällige E-Learning PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden
|
LmsActRenewNotify: Neue zufällige E‑Learning PIN zuweisen und Benachrichtigung per Post oder E-Mail versenden
|
||||||
LmsNotificationSend n@Int: E-Learning Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet.
|
LmsStatusNotificationSent: Anmeldedaten wurden an Prüfling oder Ansprechpartner per Post oder E#{nonBreakableDash}Mail versendet; E#{nonBreakableDash}Learning ist derzeit offen
|
||||||
LmsPinRenewal n@Int: E-Learning Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}.
|
LmsNotificationSend n@Int: E‑Learning Benachrichtigungen an #{n} #{pluralDE n "Prüfling" "Prüflinge"} werden per Post oder E-Mail versendet.
|
||||||
|
LmsPinRenewal n@Int: E‑Learning Pin ausgetauscht für #{n} #{pluralDE n "Prüfling" "Prüflinge"}.
|
||||||
LmsActionFailed n@Int: Aktion nicht durchgeführt für #{n} #{pluralDE n "Person" "Personen"}, da diese derzeit nicht an einer Prüfung teilnehmen.
|
LmsActionFailed n@Int: Aktion nicht durchgeführt für #{n} #{pluralDE n "Person" "Personen"}, da diese derzeit nicht an einer Prüfung teilnehmen.
|
||||||
LmsStarted: E-Learning eröffnet
|
LmsStarted: E‑Learning eröffnet
|
||||||
LmsAutomaticQueuing n@Natural: Die folgenden Funktionen werden normalerweise einmal pro Tag um #{show n} Uhr ausgeführt.
|
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.
|
LmsManualQueuing: Die folgenden Funktionen sollten einmal pro Tag ausgeführt werden.
|
||||||
BtnLmsEnqueue: Nutzer mit ablaufenden Qualifikationen zum E-Learning anmelden und benachrichtigen
|
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
|
||||||
|
|||||||
@ -8,8 +8,8 @@ QualificationDescription: Description
|
|||||||
QualificationValidDuration: Validity period
|
QualificationValidDuration: Validity period
|
||||||
QualificationAuditDuration: Audit log keept
|
QualificationAuditDuration: Audit log keept
|
||||||
QualificationRefreshWithin: Refresh within
|
QualificationRefreshWithin: Refresh within
|
||||||
QualificationRefreshWithinTooltip: Period before expiry to send a notification or to start e-learning
|
QualificationRefreshWithinTooltip: Period before expiry to send a notification or to start e‑learning
|
||||||
QualificationElearningStart: Is e-learning automatically started?
|
QualificationElearningStart: Is e‑learning automatically started?
|
||||||
TableQualificationCountActive: Active
|
TableQualificationCountActive: Active
|
||||||
TableQualificationCountActiveTooltip: Number of currently valid qualification holders
|
TableQualificationCountActiveTooltip: Number of currently valid qualification holders
|
||||||
TableQualificationCountTotal: Total
|
TableQualificationCountTotal: Total
|
||||||
@ -41,19 +41,24 @@ TableLmsStaff: Staff?
|
|||||||
TableLmsStarted: Started
|
TableLmsStarted: Started
|
||||||
TableLmsReceived: Last update
|
TableLmsReceived: Last update
|
||||||
TableLmsNotified: Notification sent
|
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!
|
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
|
TableLmsEnded: Ended
|
||||||
TableLmsStatus: Status e-learning
|
TableLmsStatus: Status e‑learning
|
||||||
TableLmsStatusTooltip mbMonth: Shows since when an e-learning is open or when it was closed, including the result. #{maybeToMessage "Shown for " (fmap (flip pluralENsN "month") mbMonth) " after closure."}
|
TableLmsStatusTooltip mbMonth: Shows #{maybeToMessage "for up to " (fmap (flip pluralENsN "month") mbMonth) " after closure"} the last e#{nonBreakableDash}learning status change:
|
||||||
TableLmsStatusDay: Date of last e-learning status change
|
TableLmsStatusDay: Date of last e‑learning status change
|
||||||
TableLmsSuccess: Completed
|
TableLmsSuccess: Completed
|
||||||
TableLmsFailed: Blocked
|
TableLmsFailed: Blocked
|
||||||
|
LmsStatusBlocked: Failed after too many attempts
|
||||||
|
LmsStatusExpired: Failed due to expiry
|
||||||
|
LmsStatusSuccess: Passed
|
||||||
|
LmsStatusPlanned: E#{nonBreakableDash}learning is about to be opened (visible to Admins only)
|
||||||
|
LmsStatusDelay: Note that status changes may occassionaly require more than a hour to be displayed here.
|
||||||
FilterLmsValid: Currently valid
|
FilterLmsValid: Currently valid
|
||||||
FilterLmsRenewal: Renewal due
|
FilterLmsRenewal: Renewal due
|
||||||
FilterLmsNotified: Notified
|
FilterLmsNotified: Notified
|
||||||
CsvColumnLmsIdent: E-learning identifier, unique for each qualification and user
|
CsvColumnLmsIdent: E#{nonBreakableDash}learning identifier, unique for each qualification and user
|
||||||
CsvColumnLmsPin: PIN for e-learning access
|
CsvColumnLmsPin: PIN for e#{nonBreakableDash}learning access
|
||||||
CsvColumnLmsResetPin: Will the e-learning PIN be reset upon next synchronisation?
|
CsvColumnLmsResetPin: Will the e#{nonBreakableDash}learning PIN be reset upon next synchronisation?
|
||||||
CsvColumnLmsDelete: Will the identifier be deleted from the E-learning platfrom upon next synchronisation?
|
CsvColumnLmsDelete: Will the identifier be deleted from the E-learning platfrom upon next synchronisation?
|
||||||
CsvColumnLmsStaff: Is the user an internal staff member? (Legacy, currently ignored)
|
CsvColumnLmsStaff: Is the user an internal staff member? (Legacy, currently ignored)
|
||||||
CsvColumnLmsSuccess: Timestamp of successful completion (UTC)
|
CsvColumnLmsSuccess: Timestamp of successful completion (UTC)
|
||||||
@ -69,13 +74,13 @@ LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically
|
|||||||
MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
|
MailSubjectQualificationRenewal qname: Qualification #{qname} must be renewed shortly
|
||||||
MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
|
MailSubjectQualificationExpiry qname: Qualification #{qname} expires soon
|
||||||
MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
|
MailSubjectQualificationExpired qname: Qualification #{qname} is no longer valid
|
||||||
MailBodyQualificationRenewal qname: The qualification #{qname} must be renewed soon by completing an e-learning course, otherwise it will expire. Supervisors are kindly requested to forward the login data confidentially to the examinee.
|
MailBodyQualificationRenewal qname: The qualification #{qname} must be renewed soon by completing an e‑learning course, otherwise it will expire. Supervisors are kindly requested to forward the login data confidentially to the examinee.
|
||||||
MailBodyQualificationExpiry: This qualification expires soon. You may then no longer execute any duties that require this qualification as a precondition!
|
MailBodyQualificationExpiry: This qualification expires soon. You may then no longer execute any duties that require this qualification as a precondition!
|
||||||
MailBodyQualificationExpired: This qualification is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e-learning.
|
MailBodyQualificationExpired: This qualification is now expired. You may no longer execute any duties that require this qualification as a precondition! It is possible that the qualification expired prematurely, e.g. due to a failed compulsory e‑learning.
|
||||||
QualificationActExpire: Discontinue - qualification expires silently
|
QualificationActExpire: Discontinue - qualification expires silently
|
||||||
QualificationActUnexpire: Continue - send a possibly fee-paying notification upon due renewal
|
QualificationActUnexpire: Continue - send a possibly fee-paying notification upon due renewal
|
||||||
QualificationSetExpire n: Expiry notification and e-learning deactivated for #{n} #{pluralENs n "person"}
|
QualificationSetExpire n: Expiry notification and e‑learning deactivated for #{n} #{pluralENs n "person"}
|
||||||
QualificationSetUnexpire n: Expiry notification and e-learning activated for #{n} #{pluralENs n "person"}
|
QualificationSetUnexpire n: Expiry notification and e‑learning activated for #{n} #{pluralENs n "person"}
|
||||||
QualificationActBlockSupervisor: Waive permanently, effective immediately
|
QualificationActBlockSupervisor: Waive permanently, effective immediately
|
||||||
QualificationActBlock: Revoke
|
QualificationActBlock: Revoke
|
||||||
QualificationActUnblock: Clear revocation
|
QualificationActUnblock: Clear revocation
|
||||||
@ -83,14 +88,15 @@ QualificationStatusBlock l n m: #{n}/#{m} #{l} revoked
|
|||||||
QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated
|
QualificationStatusUnblock l n m: #{n}/#{m} #{l} reactivated
|
||||||
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter.
|
LmsRenewalInstructions: Instruction on how to accomplish the renewal are enclosed in the attached PDF. In order to avoid misuse, the PDF is encrypted with the FRADrive PDF-password of the examinee. If no PDF-password had been chosen yet, then the password is the Fraport id card number of the examinee, including the punctuation mark and the digit thereafter.
|
||||||
LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only.
|
LmsNoRenewal: Unfortunately, this particular qualification cannot be renewed through E-learning only.
|
||||||
LmsActNotify: Resend e-learning notification by post or email
|
LmsActNotify: Resend e‑learning notification by post or email
|
||||||
LmsActRenewPin: Randomly replace e-learning PIN
|
LmsActRenewPin: Randomly replace e‑learning PIN
|
||||||
LmsActRenewNotify: Randomly replace e-learning PIN and re-send notification by post or email
|
LmsActRenewNotify: Randomly replace e‑learning PIN and re-send notification by post or email
|
||||||
|
LmsStatusNotificationSent: E-learning pin has been sent to examinee or supervisor by letter post or by email; e‑learning is currently open
|
||||||
LmsNotificationSend n: E-learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email.
|
LmsNotificationSend n: E-learning notifications will be sent to #{n} #{pluralENs n "examinee"} by letter post or by email.
|
||||||
LmsPinRenewal n: E-learning pin replaced randomly for #{n} #{pluralENs n "examinee"}.
|
LmsPinRenewal n: E-learning pin replaced randomly for #{n} #{pluralENs n "examinee"}.
|
||||||
LmsActionFailed n: No action for #{n} #{pluralENs n "person"}, since there was no ongoing examination.
|
LmsActionFailed n: No action for #{n} #{pluralENs n "person"}, since there was no ongoing examination.
|
||||||
LmsStarted: E-learning open since
|
LmsStarted: E-learning open since
|
||||||
LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock.
|
LmsAutomaticQueuing n@Natural: The following functions are executed daily at #{show n} o'clock.
|
||||||
LmsManualQueuing: The following functions should be executed daily.
|
LmsManualQueuing: The following functions should be executed daily.
|
||||||
BtnLmsEnqueue: Enqueue users with expiring qualifications for e-learning and notify them.
|
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.
|
||||||
|
|||||||
@ -16,7 +16,7 @@ TableTerm !ident-ok: Semester
|
|||||||
TableCourseSchool: Institut
|
TableCourseSchool: Institut
|
||||||
TableSubmissionGroup: Feste Abgabegruppe
|
TableSubmissionGroup: Feste Abgabegruppe
|
||||||
TableNoSubmissionGroup: Keine feste Abgabegruppe
|
TableNoSubmissionGroup: Keine feste Abgabegruppe
|
||||||
TableMatrikelNr: Matrikelnummer
|
TableMatrikelNr: AVS Nr
|
||||||
TableSex: Geschlecht
|
TableSex: Geschlecht
|
||||||
TableBirthday: Geburtsdatum
|
TableBirthday: Geburtsdatum
|
||||||
TableSchool: Institut
|
TableSchool: Institut
|
||||||
@ -56,7 +56,7 @@ TableTutorialTime: Zeit
|
|||||||
TableTutorialDeregisterUntil: Abmeldungen bis
|
TableTutorialDeregisterUntil: Abmeldungen bis
|
||||||
TableActionsHead: Aktionen
|
TableActionsHead: Aktionen
|
||||||
TableNoFilter: Keine Einschränkung
|
TableNoFilter: Keine Einschränkung
|
||||||
TableUserMatriculation: Matrikelnummer
|
TableUserMatriculation: ASV Nummer
|
||||||
TableColumnStudyFeatures: Studiendaten
|
TableColumnStudyFeatures: Studiendaten
|
||||||
TableSchoolShort: Kürzel
|
TableSchoolShort: Kürzel
|
||||||
TableSchoolName !ident-ok: Name
|
TableSchoolName !ident-ok: Name
|
||||||
|
|||||||
@ -16,7 +16,7 @@ TableTerm: Semester
|
|||||||
TableCourseSchool: Department
|
TableCourseSchool: Department
|
||||||
TableSubmissionGroup: Registered submission group
|
TableSubmissionGroup: Registered submission group
|
||||||
TableNoSubmissionGroup: No registered submission group
|
TableNoSubmissionGroup: No registered submission group
|
||||||
TableMatrikelNr: Matriculation
|
TableMatrikelNr: AVS No
|
||||||
TableSex: Sex
|
TableSex: Sex
|
||||||
TableBirthday: Birthday
|
TableBirthday: Birthday
|
||||||
TableSchool: Department
|
TableSchool: Department
|
||||||
@ -56,7 +56,7 @@ TableTutorialDeregisterUntil: Deregister until
|
|||||||
TableActionsHead: Actions
|
TableActionsHead: Actions
|
||||||
TableTutorialTime: Time
|
TableTutorialTime: Time
|
||||||
TableNoFilter: No restriction
|
TableNoFilter: No restriction
|
||||||
TableUserMatriculation: Matriculation
|
TableUserMatriculation: AVS Number
|
||||||
TableColumnStudyFeatures: Features of study
|
TableColumnStudyFeatures: Features of study
|
||||||
TableSchoolShort: Shorthand
|
TableSchoolShort: Shorthand
|
||||||
TableSchoolName: Name
|
TableSchoolName: Name
|
||||||
|
|||||||
1
routes
1
routes
@ -67,6 +67,7 @@
|
|||||||
/admin/tokens AdminTokensR GET POST
|
/admin/tokens AdminTokensR GET POST
|
||||||
/admin/crontab AdminCrontabR GET
|
/admin/crontab AdminCrontabR GET
|
||||||
/admin/avs AdminAvsR GET POST
|
/admin/avs AdminAvsR GET POST
|
||||||
|
/admin/avs/#CryptoUUIDUser AdminAvsUserR GET
|
||||||
/admin/ldap AdminLdapR GET POST
|
/admin/ldap AdminLdapR GET POST
|
||||||
/admin/problems AdminProblemsR GET
|
/admin/problems AdminProblemsR GET
|
||||||
/admin/problems/no-contact ProblemUnreachableR GET
|
/admin/problems/no-contact ProblemUnreachableR GET
|
||||||
|
|||||||
@ -251,6 +251,13 @@ embedRenderMessage ''UniWorX ''AvsLicence id -- required by UniWorXAvsMessages
|
|||||||
mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal"
|
mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal"
|
||||||
mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-formal"
|
mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-formal"
|
||||||
|
|
||||||
|
instance RenderMessage UniWorX AvsDataCardColor where
|
||||||
|
renderMessage _foundation _ls (AvsCardColorMisc t) = Text.cons '*' t
|
||||||
|
renderMessage f ls AvsCardColorGrün = renderMessage f ls MsgAvsCardColorGreen
|
||||||
|
renderMessage f ls AvsCardColorBlau = renderMessage f ls MsgAvsCardColorBlue
|
||||||
|
renderMessage f ls AvsCardColorRot = renderMessage f ls MsgAvsCardColorRed
|
||||||
|
renderMessage f ls AvsCardColorGelb = renderMessage f ls MsgAvsCardColorYellow
|
||||||
|
|
||||||
instance RenderMessage UniWorX TermIdentifier where
|
instance RenderMessage UniWorX TermIdentifier where
|
||||||
renderMessage _foundation _ls = termToText -- TODO: respect user selected Datetime Format
|
renderMessage _foundation _ls = termToText -- TODO: respect user selected Datetime Format
|
||||||
|
|
||||||
|
|||||||
@ -113,6 +113,7 @@ breadcrumb AdminErrMsgR = i18nCrumb MsgMenuAdminErrMsg $ Just
|
|||||||
breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR
|
breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR
|
||||||
breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR
|
breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR
|
||||||
breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR
|
breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR
|
||||||
|
breadcrumb AdminAvsUserR{} = i18nCrumb MsgAvsPersonInfo $ Just AdminAvsR
|
||||||
breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR
|
breadcrumb AdminLdapR = i18nCrumb MsgMenuLdap $ Just AdminR
|
||||||
breadcrumb AdminProblemsR = i18nCrumb MsgProblemsHeading $ Just AdminR
|
breadcrumb AdminProblemsR = i18nCrumb MsgProblemsHeading $ Just AdminR
|
||||||
breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR
|
breadcrumb ProblemUnreachableR = i18nCrumb MsgProblemsUnreachableHeading $ Just AdminProblemsR
|
||||||
|
|||||||
@ -51,11 +51,12 @@ getAdminProblemsR = do
|
|||||||
diffLics <- try retrieveDifferingLicences <&> \case
|
diffLics <- try retrieveDifferingLicences <&> \case
|
||||||
-- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
|
-- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
|
||||||
(Left e) -> Left $ text2widget $ tshow (e :: SomeException)
|
(Left e) -> Left $ text2widget $ tshow (e :: SomeException)
|
||||||
(Right AvsLicenceDifferences{..}) -> Right ( Set.size avsLicenceDiffRevokeAll
|
(Right AvsLicenceDifferences{..}) -> Right
|
||||||
, Set.size avsLicenceDiffGrantVorfeld
|
( Set.size avsLicenceDiffRevokeAll
|
||||||
, Set.size avsLicenceDiffRevokeRollfeld
|
, Set.size avsLicenceDiffGrantVorfeld
|
||||||
, Set.size avsLicenceDiffGrantRollfeld
|
, Set.size avsLicenceDiffRevokeRollfeld
|
||||||
)
|
, Set.size avsLicenceDiffGrantRollfeld
|
||||||
|
)
|
||||||
-- Attempt to format results in a nicer way failed, since rendering Html within a modal destroyed the page layout itself
|
-- Attempt to format results in a nicer way failed, since rendering Html within a modal destroyed the page layout itself
|
||||||
-- let procDiffLics (to0, to1, to2) = Right (Set.size to0, Set.size to1, Set.size to2)
|
-- let procDiffLics (to0, to1, to2) = Right (Set.size to0, Set.size to1, Set.size to2)
|
||||||
-- diffLics <- (procDiffLics <$> retrieveDifferingLicences) `catches`
|
-- diffLics <- (procDiffLics <$> retrieveDifferingLicences) `catches`
|
||||||
@ -85,7 +86,7 @@ getAdminProblemsR = do
|
|||||||
|
|
||||||
getProblemUnreachableR :: Handler Html
|
getProblemUnreachableR :: Handler Html
|
||||||
getProblemUnreachableR = do
|
getProblemUnreachableR = do
|
||||||
unreachables <- runDB retrieveUnreachableUsers'
|
unreachables <- runDB retrieveUnreachableUsers
|
||||||
siteLayoutMsg MsgProblemsUnreachableHeading $ do
|
siteLayoutMsg MsgProblemsUnreachableHeading $ do
|
||||||
setTitleI MsgProblemsUnreachableHeading
|
setTitleI MsgProblemsUnreachableHeading
|
||||||
[whamlet|
|
[whamlet|
|
||||||
@ -94,7 +95,7 @@ getProblemUnreachableR = do
|
|||||||
<ul>
|
<ul>
|
||||||
$forall usr <- unreachables
|
$forall usr <- unreachables
|
||||||
<li>
|
<li>
|
||||||
^{linkUserWidget ForProfileR usr} (#{usr ^. _userDisplayEmail} / #{usr ^. _userEmail})
|
^{linkUserWidget ForProfileDataR usr} (#{usr ^. _userDisplayEmail} / #{usr ^. _userEmail})
|
||||||
|]
|
|]
|
||||||
|
|
||||||
getProblemFbutNoR :: Handler Html
|
getProblemFbutNoR :: Handler Html
|
||||||
@ -141,31 +142,30 @@ mkUnreachableUsersTable = do
|
|||||||
-}
|
-}
|
||||||
|
|
||||||
areAllUsersReachable :: DB Bool
|
areAllUsersReachable :: DB Bool
|
||||||
-- areAllUsersReachable = isNothing <$> E.selectOne retrieveUnreachableUsers
|
-- areAllUsersReachable = isNothing <$> E.selectOne retrieveUnreachableUsers'
|
||||||
areAllUsersReachable = E.selectNotExists retrieveUnreachableUsers
|
-- areAllUsersReachable = E.selectNotExists retrieveUnreachableUsers'
|
||||||
|
areAllUsersReachable = null <$> retrieveUnreachableUsers
|
||||||
|
|
||||||
|
-- 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.||. user E.^. UserCompanyPersonalNumber `E.ilike` E.justVal "E%")
|
||||||
|
-- E.&&. E.not_ ((user E.^. UserDisplayEmail) `E.like` E.val "%@%.%")
|
||||||
|
-- E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%")
|
||||||
|
-- return user
|
||||||
|
|
||||||
retrieveUnreachableUsers :: E.SqlQuery (E.SqlExpr (Entity User))
|
retrieveUnreachableUsers :: DB [Entity User]
|
||||||
retrieveUnreachableUsers = do
|
retrieveUnreachableUsers = do
|
||||||
user <- E.from $ E.table @User
|
emailOnlyUsers <- E.select $ do
|
||||||
E.where_ $ E.isNothing (user E.^. UserPostAddress)
|
user <- E.from $ E.table @User
|
||||||
E.&&. E.isNothing (user E.^. UserCompanyDepartment)
|
E.where_ $ E.isNothing (user E.^. UserPostAddress)
|
||||||
E.&&. E.not_ ((user E.^. UserDisplayEmail) `E.like` E.val "%@%.%")
|
E.&&. (E.isNothing (user E.^. UserCompanyDepartment) E.||. user E.^. UserCompanyPersonalNumber `E.ilike` E.justVal "E%")
|
||||||
E.&&. E.not_ ((user E.^. UserEmail) `E.like` E.val "%@%.%")
|
return user
|
||||||
return user
|
return $ filter hasInvalidEmail emailOnlyUsers
|
||||||
|
where
|
||||||
retrieveUnreachableUsers' :: DB [Entity User]
|
hasInvalidEmail = isNothing . getEmailAddress . entityVal
|
||||||
retrieveUnreachableUsers' = do
|
|
||||||
obviousUnreachable <- E.select retrieveUnreachableUsers
|
|
||||||
emailUsers <- E.select $ do
|
|
||||||
user <- E.from $ E.table @User
|
|
||||||
E.where_ $ E.isNothing (user E.^. UserPostAddress)
|
|
||||||
E.&&. E.isNothing (user E.^. UserCompanyDepartment)
|
|
||||||
E.&&. ( ((user E.^. UserDisplayEmail) `E.like` E.val "%@%.%")
|
|
||||||
E.||. ((user E.^. UserEmail) `E.like` E.val "%@%.%"))
|
|
||||||
pure user
|
|
||||||
let hasInvalidEmail = isNothing . getEmailAddress . entityVal
|
|
||||||
invaldEmail = filter hasInvalidEmail emailUsers
|
|
||||||
return $ obviousUnreachable ++ invaldEmail
|
|
||||||
|
|
||||||
allDriversHaveAvsId :: Day -> DB Bool
|
allDriversHaveAvsId :: Day -> DB Bool
|
||||||
-- allDriversHaveAvsId = fmap isNothing . E.selectOne . retrieveDriversWithoutAvsId
|
-- allDriversHaveAvsId = fmap isNothing . E.selectOne . retrieveDriversWithoutAvsId
|
||||||
|
|||||||
@ -9,6 +9,7 @@
|
|||||||
|
|
||||||
module Handler.Admin.Avs
|
module Handler.Admin.Avs
|
||||||
( getAdminAvsR, postAdminAvsR
|
( getAdminAvsR, postAdminAvsR
|
||||||
|
, getAdminAvsUserR
|
||||||
, getProblemAvsSynchR, postProblemAvsSynchR
|
, getProblemAvsSynchR, postProblemAvsSynchR
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -144,7 +145,7 @@ postAdminAvsR = do
|
|||||||
|]
|
|]
|
||||||
mAvsQuery <- getsYesod $ view _appAvsQuery
|
mAvsQuery <- getsYesod $ view _appAvsQuery
|
||||||
case mAvsQuery of
|
case mAvsQuery of
|
||||||
Nothing -> return mempty
|
Nothing -> siteLayoutMsg MsgMenuAvs [whamlet|Error: AVS interface configuration is incomplete.|] -- should never occur after initilisation
|
||||||
Just AvsQuery{..} -> do
|
Just AvsQuery{..} -> do
|
||||||
((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
|
((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
|
||||||
|
|
||||||
@ -365,7 +366,8 @@ postProblemAvsSynchR = getProblemAvsSynchR
|
|||||||
getProblemAvsSynchR = do
|
getProblemAvsSynchR = do
|
||||||
let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
|
let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
|
||||||
catchAllAvs = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload; do not call redirect within catchAllAvs actions!
|
catchAllAvs = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload; do not call redirect within catchAllAvs actions!
|
||||||
AvsLicenceDifferences{..} <- catchAllAvs' AdminR retrieveDifferingLicences
|
(AvsLicenceDifferences{..}, apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
|
||||||
|
-- TODO: for all ids, uery PersonStatus and create a Map from AvsId to a List of all valid Cards
|
||||||
|
|
||||||
--
|
--
|
||||||
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
|
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
|
||||||
@ -421,10 +423,10 @@ getProblemAvsSynchR = do
|
|||||||
|
|
||||||
-- licence differences
|
-- licence differences
|
||||||
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
|
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
|
||||||
<$> mkLicenceTable "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
<$> mkLicenceTable apidStatus "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
||||||
<*> mkLicenceTable "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
<*> mkLicenceTable apidStatus "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||||
<*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
<*> mkLicenceTable apidStatus "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
||||||
<*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
<*> mkLicenceTable apidStatus "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
||||||
|
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
let nowaday = utctDay now
|
let nowaday = utctDay now
|
||||||
@ -510,8 +512,8 @@ instance HasUser LicenceTableData where
|
|||||||
hasUser = resultUser . _entityVal
|
hasUser = resultUser . _entityVal
|
||||||
|
|
||||||
|
|
||||||
mkLicenceTable :: Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
mkLicenceTable :: AvsPersonIdMapPersonCard -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||||
mkLicenceTable dbtIdent aLic apids = do
|
mkLicenceTable apidStatus dbtIdent aLic apids = do
|
||||||
currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
|
currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
|
||||||
avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] []
|
avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] []
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
@ -535,7 +537,7 @@ mkLicenceTable dbtIdent aLic apids = do
|
|||||||
[ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId)
|
[ dbSelect (applying _2) id $ return . view (resultUserAvs . _userAvsPersonId)
|
||||||
-- $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal
|
-- $ \DBRow{dbrOutput=(_,_,apid,_)} -> return apid -- return . view resultAvsPID -- does not type due to traversal
|
||||||
, colUserNameLink AdminUserR
|
, colUserNameLink AdminUserR
|
||||||
, sortable (Just "avspersonno") (i18nCell MsgAvsPersonNo) $ \(view resultUserAvs -> a) -> avsPersonNoCell a
|
, sortable (Just "avspersonno") (i18nCell MsgAvsPersonNo) $ \(view resultUserAvs -> a) -> avsPersonNoLinkedCell a
|
||||||
-- , colUserCompany
|
-- , colUserCompany
|
||||||
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \(view (resultUser . _entityKey) -> uid) -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
|
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \(view (resultUser . _entityKey) -> uid) -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
|
||||||
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||||
@ -553,6 +555,7 @@ mkLicenceTable dbtIdent aLic apids = do
|
|||||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
|
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
|
||||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltip
|
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltip
|
||||||
) $ \(preview $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> cellMaybe qualificationBlockedCell b
|
) $ \(preview $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> cellMaybe qualificationBlockedCell b
|
||||||
|
, sortable Nothing (i18nCell MsgTableAvsActiveCards) $ \(view $ resultUserAvs . _userAvsPersonId -> apid) -> foldMap avsPersonCardCell $ Map.lookup apid apidStatus
|
||||||
]
|
]
|
||||||
dbtSorting = mconcat
|
dbtSorting = mconcat
|
||||||
[ single $ sortUserNameLink queryUser
|
[ single $ sortUserNameLink queryUser
|
||||||
@ -630,4 +633,53 @@ mkLicenceTable dbtIdent aLic apids = do
|
|||||||
let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
|
let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
|
||||||
return (act, usrSet)
|
return (act, usrSet)
|
||||||
|
|
||||||
over _1 postprocess <$> dbTable validator DBTable{..}
|
over _1 postprocess <$> dbTable validator DBTable{..}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
getAdminAvsUserR :: CryptoUUIDUser -> Handler Html
|
||||||
|
getAdminAvsUserR uuid = do
|
||||||
|
uid <- decrypt uuid
|
||||||
|
Entity{entityVal=UserAvs{..}} <- runDB $ getBy404 $ UniqueUserAvsUser uid
|
||||||
|
mAvsQuery <- getsYesod $ view _appAvsQuery
|
||||||
|
resWgt <- case mAvsQuery of
|
||||||
|
Nothing -> return [whamlet|Error: AVS interface configuration is incomplete.|] -- should never occur after initilisation
|
||||||
|
Just AvsQuery{..} -> do
|
||||||
|
mbContact <- avsQueryContact $ AvsQueryContact $ Set.singleton $ AvsObjPersonId userAvsPersonId
|
||||||
|
mbDataPerson <- lookupAvsUser userAvsPersonId
|
||||||
|
return [whamlet|
|
||||||
|
<p>
|
||||||
|
Vorläufige Admin Ansicht AVS Daten.
|
||||||
|
Ansicht zeigt aktuelle Daten.
|
||||||
|
Es erfolgte damit aber noch kein Update der FRADrive Daten.
|
||||||
|
<p>
|
||||||
|
<dl .deflist>
|
||||||
|
<dt .deflist__dt>InfoPersonContact <br>
|
||||||
|
<i>(bevorzugt)
|
||||||
|
<dd .deflist__dd>
|
||||||
|
$case mbContact
|
||||||
|
$of Left err
|
||||||
|
Fehler: #{tshow err}
|
||||||
|
$of Right contactInfo
|
||||||
|
#{decodeUtf8 (Pretty.encodePretty (toJSON contactInfo))}
|
||||||
|
<dt .deflist__dt>PersonStatus und mehrere PersonSearch <br>
|
||||||
|
<i>(benötigt mehrere AVS Abfragen)
|
||||||
|
<dd .deflist__dd>
|
||||||
|
$maybe dataPerson <- mbDataPerson
|
||||||
|
#{decodeUtf8 (Pretty.encodePretty (toJSON dataPerson))}
|
||||||
|
$nothing
|
||||||
|
Keine Daten erhalten.
|
||||||
|
<h3>
|
||||||
|
Provisorische formatierte Ansicht
|
||||||
|
<p>
|
||||||
|
Generisch formatierte Ansicht, die zeigt, in welche Richtung die Endansicht gehen könnte.
|
||||||
|
In der Endansicht wären nur ausgewählte Felder mit besserer Bennenung in einer manuell gewählten Reihenfolge sichtbar.
|
||||||
|
<p>
|
||||||
|
^{foldMap jsonWidget mbContact}
|
||||||
|
<p>
|
||||||
|
^{foldMap jsonWidget mbDataPerson}
|
||||||
|
|]
|
||||||
|
let heading = [whamlet|_{MsgAvsPersonNo} #{userAvsNoPerson}|]
|
||||||
|
siteLayout heading $ do
|
||||||
|
setTitle $ toHtml $ show userAvsNoPerson
|
||||||
|
resWgt
|
||||||
|
|||||||
@ -91,8 +91,8 @@ postLmsAllR = do
|
|||||||
|
|
||||||
lmsTable <- runDB $ do
|
lmsTable <- runDB $ do
|
||||||
view _2 <$> mkLmsAllTable isAdmin
|
view _2 <$> mkLmsAllTable isAdmin
|
||||||
siteLayoutMsg MsgMenuQualifications $ do
|
siteLayoutMsg MsgMenuLms $ do
|
||||||
setTitleI MsgMenuQualifications
|
setTitleI MsgMenuLms
|
||||||
$(widgetFile "lms-all")
|
$(widgetFile "lms-all")
|
||||||
|
|
||||||
type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64, Ex.Value Word64)
|
type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64, Ex.Value Word64)
|
||||||
@ -615,13 +615,13 @@ postLmsR sid qsh = do
|
|||||||
when (diffSelected /= 0) $ addMessageI Warning $ MsgLmsActionFailed diffSelected
|
when (diffSelected /= 0) $ addMessageI Warning $ MsgLmsActionFailed diffSelected
|
||||||
redirect currentRoute
|
redirect currentRoute
|
||||||
|
|
||||||
let heading = citext2widget $ qualificationName quali
|
let heading = citext2widget $ "LMS " <> qualificationName quali
|
||||||
siteLayout heading $ do
|
siteLayout heading $ do
|
||||||
setTitle $ toHtml $ unSchoolKey sid <> "-" <> qsh
|
setTitle $ toHtml $ "LMS " <> unSchoolKey sid <> "-" <> qsh
|
||||||
$(widgetFile "lms")
|
$(widgetFile "lms")
|
||||||
|
|
||||||
|
|
||||||
-- intended to be viewed primarily in a modal, vie lmsStatusPlusCell'
|
-- intended to be viewed primarily in a modal, wie lmsStatusPlusCell
|
||||||
getLmsUserR :: CryptoUUIDUser -> Handler Html
|
getLmsUserR :: CryptoUUIDUser -> Handler Html
|
||||||
getLmsUserR uuid = do
|
getLmsUserR uuid = do
|
||||||
uid <- decrypt uuid
|
uid <- decrypt uuid
|
||||||
@ -648,6 +648,6 @@ getLmsUserR uuid = do
|
|||||||
|
|
||||||
let heading = [whamlet|_{MsgMenuLmsUser} ^{userWidget user}|]
|
let heading = [whamlet|_{MsgMenuLmsUser} ^{userWidget user}|]
|
||||||
siteLayout heading $ do
|
siteLayout heading $ do
|
||||||
setTitle $ toHtml $ "Qualifkationen " <> userDisplayName
|
setTitle $ toHtml userDisplayName
|
||||||
$(widgetFile "lms-user")
|
$(widgetFile "lms-user")
|
||||||
-- $(i18nWidgetFile "lms-user")
|
-- $(i18nWidgetFile "lms-user")
|
||||||
|
|||||||
@ -18,7 +18,7 @@ import Import
|
|||||||
-- import Jobs
|
-- import Jobs
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
-- import Handler.Utils.Csv
|
-- import Handler.Utils.Csv
|
||||||
-- import Handler.Utils.LMS
|
import Handler.Utils.LMS
|
||||||
|
|
||||||
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
@ -460,8 +460,8 @@ postQualificationR sid qsh = do
|
|||||||
-- , sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted)
|
-- , sortable (Just "lms-started") (i18nCell MsgTableLmsElearning <> spacerCell <> i18nCell MsgTableLmsStarted)
|
||||||
-- $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
-- $ \(preview $ resultLmsUser . _entityVal . _lmsUserStarted -> d) -> foldMap dateTimeCell d
|
||||||
-- , sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
-- , sortable (Just "lms-status") (i18nCell MsgTableLmsStatus) $ \(preview $ resultLmsUser . _entityVal . _lmsUserStatus -> status) -> foldMap lmsStatusCell $ join status
|
||||||
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltip (MsgTableLmsStatusTooltip auditMonths))
|
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltipWgt Nothing (lmsStatusInfoCell isAdmin auditMonths))
|
||||||
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell' linkLmsUser) lu
|
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap (lmsStatusPlusCell linkLmsUser) lu
|
||||||
]
|
]
|
||||||
psValidator = def & defaultSorting [SortDescBy "last-refresh"]
|
psValidator = def & defaultSorting [SortDescBy "last-refresh"]
|
||||||
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
|
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
|
||||||
|
|||||||
@ -80,7 +80,7 @@ postTUsersR tid ssh csh tutn = do
|
|||||||
psValidator = def
|
psValidator = def
|
||||||
& defaultSortingByName
|
& defaultSortingByName
|
||||||
& restrictSorting (\name _ -> none (== name) ["note", "registration", "tutorials", "exams", "submission-group", "state"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
|
& restrictSorting (\name _ -> none (== name) ["note", "registration", "tutorials", "exams", "submission-group", "state"]) -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
|
||||||
& restrictFilter (\name _ -> none (== name) ["tutorial", "exam", "submission-group", "active", "has-personalised-sheet-files"])
|
& restrictFilter (\name _ -> none (== name) ["tutorial", "exam", "submission-group", "active", "has-personalised-sheet-files"])
|
||||||
isInTut q = E.exists $ do
|
isInTut q = E.exists $ do
|
||||||
tutorialParticipant <- E.from $ E.table @TutorialParticipant
|
tutorialParticipant <- E.from $ E.table @TutorialParticipant
|
||||||
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser q E.^. UserId
|
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser q E.^. UserId
|
||||||
|
|||||||
@ -99,9 +99,7 @@ postUsersR = do
|
|||||||
, sortable (Just "name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
, sortable (Just "name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||||
(AdminUserR <$> encrypt uid)
|
(AdminUserR <$> encrypt uid)
|
||||||
(nameWidget userDisplayName userSurname)
|
(nameWidget userDisplayName userSurname)
|
||||||
-- , sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
, sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \DBRow{ dbrOutput = entUsr } -> cellHasMatrikelnummerLinked entUsr
|
||||||
-- (AdminUserR <$> encrypt uid)
|
|
||||||
-- (toWgt userMatrikelnummer)
|
|
||||||
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
|
, sortable (Just "user-company") (i18nCell MsgTableCompany) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do -- why does sqlCell not work here? Mismatch "YesodDB UniWorX" and "RWST (Maybe (Env,FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX"
|
||||||
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
companies' <- liftHandler . runDB . E.select $ E.from $ \(usrComp `E.InnerJoin` comp) -> do
|
||||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||||
@ -215,6 +213,9 @@ postUsersR = do
|
|||||||
, ( "display-name"
|
, ( "display-name"
|
||||||
, SortColumn $ \user -> user E.^. UserDisplayName
|
, SortColumn $ \user -> user E.^. UserDisplayName
|
||||||
)
|
)
|
||||||
|
, ( "matriculation"
|
||||||
|
, SortColumn $ \user -> user E.^. UserMatrikelnummer
|
||||||
|
)
|
||||||
, ( "personal-number"
|
, ( "personal-number"
|
||||||
, SortColumn $ \user -> user E.^. UserCompanyPersonalNumber
|
, SortColumn $ \user -> user E.^. UserCompanyPersonalNumber
|
||||||
)
|
)
|
||||||
@ -262,10 +263,10 @@ postUsersR = do
|
|||||||
Just needle -> (E.castString (user E.^. UserEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
|
Just needle -> (E.castString (user E.^. UserEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
|
||||||
E.||. (E.castString (user E.^. UserDisplayEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
|
E.||. (E.castString (user E.^. UserDisplayEmail) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
|
||||||
)
|
)
|
||||||
-- , ( "matriculation", FilterColumn $ \user (criteria :: Set.Set Text) -> if
|
, ( "matriculation", FilterColumn $ \user (criteria :: Set.Set Text) -> if
|
||||||
-- | Set.null criteria -> E.true -- TODO: why can this be eFalse and work still?
|
| Set.null criteria -> E.true
|
||||||
-- | otherwise -> E.any (\c -> user E.^. UserMatrikelnummer `E.hasInfix` E.val c) criteria
|
| otherwise -> E.any (\c -> user E.^. UserMatrikelnummer `E.hasInfix` E.val c) criteria
|
||||||
-- )
|
)
|
||||||
, ( "personal-number", FilterColumn $ \user (criteria :: Set.Set Text) -> if
|
, ( "personal-number", FilterColumn $ \user (criteria :: Set.Set Text) -> if
|
||||||
| Set.null criteria -> E.true -- TODO: why can this be eFalse and work still?
|
| Set.null criteria -> E.true -- TODO: why can this be eFalse and work still?
|
||||||
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
|
| otherwise -> E.any (\c -> user E.^. UserCompanyPersonalNumber `E.hasInfix` E.val c) criteria
|
||||||
|
|||||||
@ -14,11 +14,13 @@ module Handler.Utils.Avs
|
|||||||
-- , getLicence, getLicenceDB, getLicenceByAvsId -- not supported by interface
|
-- , getLicence, getLicenceDB, getLicenceByAvsId -- not supported by interface
|
||||||
, AvsLicenceDifferences(..)
|
, AvsLicenceDifferences(..)
|
||||||
, setLicence, setLicenceAvs, setLicencesAvs
|
, setLicence, setLicenceAvs, setLicencesAvs
|
||||||
, retrieveDifferingLicences, computeDifferingLicences
|
, retrieveDifferingLicences, retrieveDifferingLicencesStatus
|
||||||
|
, computeDifferingLicences
|
||||||
, synchAvsLicences
|
, synchAvsLicences
|
||||||
, lookupAvsUser, lookupAvsUsers
|
, lookupAvsUser, lookupAvsUsers
|
||||||
, AvsException(..)
|
, AvsException(..)
|
||||||
, updateReceivers
|
, updateReceivers
|
||||||
|
, AvsPersonIdMapPersonCard
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
@ -178,6 +180,18 @@ data AvsLicenceDifferences = AvsLicenceDifferences
|
|||||||
}
|
}
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
#ifdef DEVELOPMENT
|
||||||
|
-- avsLicenceDifferences2LicenceIds is not used in DEVELOPMENT build
|
||||||
|
#else
|
||||||
|
avsLicenceDifferences2LicenceIds :: AvsLicenceDifferences -> Set AvsPersonId
|
||||||
|
avsLicenceDifferences2LicenceIds AvsLicenceDifferences{..} = Set.unions
|
||||||
|
[ avsLicenceDiffRevokeAll
|
||||||
|
, avsLicenceDiffGrantVorfeld
|
||||||
|
, avsLicenceDiffRevokeRollfeld
|
||||||
|
, avsLicenceDiffGrantRollfeld
|
||||||
|
]
|
||||||
|
#endif
|
||||||
|
|
||||||
avsLicenceDifferences2personLicences :: AvsLicenceDifferences -> Set AvsPersonLicence
|
avsLicenceDifferences2personLicences :: AvsLicenceDifferences -> Set AvsPersonLicence
|
||||||
avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
|
avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
|
||||||
Set.map (AvsPersonLicence AvsNoLicence) avsLicenceDiffRevokeAll
|
Set.map (AvsPersonLicence AvsNoLicence) avsLicenceDiffRevokeAll
|
||||||
@ -188,24 +202,50 @@ avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
|
|||||||
computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLicence)
|
computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLicence)
|
||||||
computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDifferingLicences
|
computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDifferingLicences
|
||||||
|
|
||||||
retrieveDifferingLicences :: Handler AvsLicenceDifferences
|
type AvsPersonIdMapPersonCard = Map AvsPersonId (Set AvsDataPersonCard)
|
||||||
retrieveDifferingLicences = do
|
|
||||||
#ifdef DEVELOPMENT
|
|
||||||
avsUsrs <- runDB $ selectList [] [LimitTo 444]
|
|
||||||
getDifferingLicences $ AvsResponseGetLicences $ Set.fromList $
|
|
||||||
[ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2
|
|
||||||
, AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1
|
|
||||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts)
|
|
||||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig)
|
|
||||||
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
|
|
||||||
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
|
|
||||||
#else
|
|
||||||
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
|
||||||
allLicences <- throwLeftM avsQueryGetAllLicences
|
|
||||||
getDifferingLicences allLicences
|
|
||||||
#endif
|
|
||||||
|
|
||||||
|
|
||||||
|
avsResponseStatusMap :: AvsResponseStatus -> AvsPersonIdMapPersonCard
|
||||||
|
avsResponseStatusMap (AvsResponseStatus status) = Map.fromDistinctAscList [(avsStatusPersonID,avsStatusPersonCardStatus) | AvsStatusPerson{..}<- Set.toAscList status]
|
||||||
|
|
||||||
|
retrieveDifferingLicences :: Handler AvsLicenceDifferences
|
||||||
|
retrieveDifferingLicences = fst <$> retrieveDifferingLicences' False
|
||||||
|
|
||||||
|
retrieveDifferingLicencesStatus :: Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
|
||||||
|
retrieveDifferingLicencesStatus = retrieveDifferingLicences' True
|
||||||
|
|
||||||
|
retrieveDifferingLicences' :: Bool -> Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
|
||||||
|
retrieveDifferingLicences' getStatus = do
|
||||||
|
#ifdef DEVELOPMENT
|
||||||
|
avsUsrs <- runDB $ selectList [] [LimitTo 444]
|
||||||
|
let allLicences = AvsResponseGetLicences $ Set.fromList $
|
||||||
|
[ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2
|
||||||
|
, AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1
|
||||||
|
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts)
|
||||||
|
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig)
|
||||||
|
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
|
||||||
|
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
|
||||||
|
#else
|
||||||
|
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
||||||
|
allLicences <- throwLeftM avsQueryGetAllLicences
|
||||||
|
#endif
|
||||||
|
lDiff <- getDifferingLicences allLicences
|
||||||
|
#ifdef DEVELOPMENT
|
||||||
|
let mkAdpc valid color = AvsDataPersonCard valid Nothing Nothing color (Set.singleton 'F') Nothing Nothing Nothing Nothing (AvsCardNo "1234") "5"
|
||||||
|
lStat = AvsResponseStatus $ bool mempty fakes getStatus -- not really needed, but avoids unused variable error
|
||||||
|
fakes = Set.fromList $
|
||||||
|
[ AvsStatusPerson (AvsPersonId 77 ) $ Set.singleton $ mkAdpc True AvsCardColorGelb
|
||||||
|
, AvsStatusPerson (AvsPersonId 12345678) $ Set.fromList [mkAdpc False AvsCardColorGrün, mkAdpc True AvsCardColorGelb, mkAdpc False AvsCardColorBlau, mkAdpc True AvsCardColorRot, mkAdpc True $ AvsCardColorMisc "Violett"]
|
||||||
|
, AvsStatusPerson (AvsPersonId 5 ) $ Set.fromList [mkAdpc True AvsCardColorGrün, mkAdpc False AvsCardColorGelb, mkAdpc True AvsCardColorBlau, mkAdpc False AvsCardColorRot, mkAdpc True $ AvsCardColorMisc "Pink"]
|
||||||
|
, AvsStatusPerson (AvsPersonId 2 ) $ Set.singleton $ mkAdpc True AvsCardColorGrün
|
||||||
|
] <>
|
||||||
|
[ AvsStatusPerson avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
|
||||||
|
#else
|
||||||
|
let statQry = avsLicenceDifferences2LicenceIds lDiff
|
||||||
|
lStat <- if getStatus && notNull statQry then throwLeftM $ avsQueryStatus $ AvsQueryStatus statQry else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
|
||||||
|
#endif
|
||||||
|
return (lDiff, avsResponseStatusMap lStat)
|
||||||
|
|
||||||
|
|
||||||
getDifferingLicences :: AvsResponseGetLicences -> Handler AvsLicenceDifferences
|
getDifferingLicences :: AvsResponseGetLicences -> Handler AvsLicenceDifferences
|
||||||
getDifferingLicences (AvsResponseGetLicences licences) = do
|
getDifferingLicences (AvsResponseGetLicences licences) = do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
@ -394,7 +434,7 @@ upsertAvsUserById api = do
|
|||||||
, audSurname = avsSurname
|
, audSurname = avsSurname
|
||||||
, audDisplayName = avsFirstName <> Text.cons ' ' avsSurname
|
, audDisplayName = avsFirstName <> Text.cons ' ' avsSurname
|
||||||
, audDisplayEmail = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
|
, audDisplayEmail = "" -- Email is unknown in this version of the avs query, to be updated later (FUTURE TODO)
|
||||||
, audMatriculation = Nothing
|
, audMatriculation = Just $ tshow avsPersonPersonNo
|
||||||
, audSex = Nothing
|
, audSex = Nothing
|
||||||
, audBirthday = Nothing
|
, audBirthday = Nothing
|
||||||
, audMobile = Nothing
|
, audMobile = Nothing
|
||||||
@ -420,7 +460,7 @@ upsertAvsUserById api = do
|
|||||||
return mbUid
|
return mbUid
|
||||||
|
|
||||||
(Just (Entity _ UserAvs{userAvsUser=uid})
|
(Just (Entity _ UserAvs{userAvsUser=uid})
|
||||||
, Just AvsDataPerson{avsPersonPersonCards, avsPersonInternalPersonalNo, avsPersonFirstName= Text.strip -> avsFirstName, avsPersonLastName= Text.strip -> avsSurname}) -> do -- known user, update address and pinPassword
|
, Just AvsDataPerson{avsPersonPersonCards, avsPersonInternalPersonalNo, avsPersonPersonNo, avsPersonFirstName= Text.strip -> avsFirstName, avsPersonLastName= Text.strip -> avsSurname}) -> do -- known user, update address and pinPassword
|
||||||
let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
|
let (mbCompany, mbCoFirmAddr, _) = guessLicenceAddress avsPersonPersonCards
|
||||||
userFirmAddr = plaintextToStoredMarkup <$> mbCoFirmAddr
|
userFirmAddr = plaintextToStoredMarkup <$> mbCoFirmAddr
|
||||||
pinCard = Set.lookupMax avsPersonPersonCards
|
pinCard = Set.lookupMax avsPersonPersonCards
|
||||||
@ -430,6 +470,7 @@ upsertAvsUserById api = do
|
|||||||
update uid [ UserFirstName =. avsFirstName -- update in case of name changes via AVS; might be changed again through LDAP
|
update uid [ UserFirstName =. avsFirstName -- update in case of name changes via AVS; might be changed again through LDAP
|
||||||
, UserSurname =. avsSurname
|
, UserSurname =. avsSurname
|
||||||
, UserDisplayName =. avsFirstName <> Text.cons ' ' avsSurname
|
, UserDisplayName =. avsFirstName <> Text.cons ' ' avsSurname
|
||||||
|
, UserMatrikelnummer =. Just (tshow avsPersonPersonNo) -- TODO: Deactivate this update after Q2/2023; this is only needed since UserMatrikelnummer was used for AVSNO later
|
||||||
, UserCompanyPersonalNumber =. avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
|
, UserCompanyPersonalNumber =. avsInternalPersonalNo <$> canonical avsPersonInternalPersonalNo
|
||||||
]
|
]
|
||||||
oldCards <- selectList [UserAvsCardPersonId ==. api] []
|
oldCards <- selectList [UserAvsCardPersonId ==. api] []
|
||||||
|
|||||||
@ -20,6 +20,7 @@ module Handler.Utils.LMS
|
|||||||
, lmsDeletionDate
|
, lmsDeletionDate
|
||||||
, lmsUserToDelete, _lmsUserToDelete
|
, lmsUserToDelete, _lmsUserToDelete
|
||||||
, lmsUserToDeleteExpr
|
, lmsUserToDeleteExpr
|
||||||
|
, lmsStatusInfoCell
|
||||||
, lmsStatusIcon, lmsUserStatusWidget
|
, lmsStatusIcon, lmsUserStatusWidget
|
||||||
, randomLMSIdent, randomLMSIdentBut
|
, randomLMSIdent, randomLMSIdentBut
|
||||||
, randomLMSpw, maxLmsUserIdentRetries
|
, randomLMSpw, maxLmsUserIdentRetries
|
||||||
@ -103,15 +104,15 @@ makeLmsFilename ftag (citext2lower -> qsh) = do
|
|||||||
getYMTH :: MonadHandler m => m Text
|
getYMTH :: MonadHandler m => m Text
|
||||||
getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime
|
getYMTH = formatTime' "%Y%m%d%H" =<< liftIO getCurrentTime
|
||||||
|
|
||||||
--
|
--
|
||||||
lmsDeletionDate :: Handler Day
|
lmsDeletionDate :: Handler Day
|
||||||
lmsDeletionDate = do
|
lmsDeletionDate = do
|
||||||
LmsConf{lmsDeletionDays} <- getsYesod $ view _appLmsConf
|
LmsConf{lmsDeletionDays} <- getsYesod $ view _appLmsConf
|
||||||
addDays (fromIntegral $ negate lmsDeletionDays) . utctDay <$> liftIO getCurrentTime
|
addDays (fromIntegral $ negate lmsDeletionDays) . utctDay <$> liftIO getCurrentTime
|
||||||
|
|
||||||
-- | Decide whether LMS platform should delete an identifier
|
-- | Decide whether LMS platform should delete an identifier
|
||||||
lmsUserToDeleteExpr :: Day -> E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
|
lmsUserToDeleteExpr :: Day -> E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
|
||||||
lmsUserToDeleteExpr cutoff lmslist = E.isNothing (lmslist E.^. LmsUserEnded)
|
lmsUserToDeleteExpr cutoff lmslist = E.isNothing (lmslist E.^. LmsUserEnded)
|
||||||
E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserStatus)
|
E.&&. E.not_ (E.isNothing $ lmslist E.^. LmsUserStatus)
|
||||||
E.&&. E.explicitUnsafeCoerceSqlExprValue "timestamp" ((lmslist E.^. LmsUserStatus) E.#>>. "{day}") E.<=. E.val cutoff
|
E.&&. E.explicitUnsafeCoerceSqlExprValue "timestamp" ((lmslist E.^. LmsUserStatus) E.#>>. "{day}") E.<=. E.val cutoff
|
||||||
|
|
||||||
@ -154,29 +155,58 @@ randomLMSIdent = LmsIdent <$> randomText [] lengthIdent -- idents must not conta
|
|||||||
|
|
||||||
randomLMSIdentBut :: MonadIO m => Set LmsIdent -> m (Maybe LmsIdent)
|
randomLMSIdentBut :: MonadIO m => Set LmsIdent -> m (Maybe LmsIdent)
|
||||||
randomLMSIdentBut banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk
|
randomLMSIdentBut banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk
|
||||||
where
|
where
|
||||||
getIdentOk = do
|
getIdentOk = do
|
||||||
l <- randomLMSIdent
|
l <- randomLMSIdent
|
||||||
return $ toMaybe (Set.notMember l banList) l
|
return $ toMaybe (Set.notMember l banList) l
|
||||||
|
|
||||||
randomLMSpw :: MonadIO m => m Text -- may contain all kinds of symbols, but our users had trouble with some, like ',' '.' ':' '_'
|
randomLMSpw :: MonadIO m => m Text -- may contain all kinds of symbols, but our users had trouble with some, like ',' '.' ':' '_'
|
||||||
randomLMSpw = randomText extra lengthPassword
|
randomLMSpw = randomText extra lengthPassword
|
||||||
where
|
where
|
||||||
extra = "+=!?" -- you cannot distinguish ;: and ., in printed letters
|
extra = "+=!?" -- you cannot distinguish ;: and ., in printed letters
|
||||||
|
|
||||||
|
lmsStatusInfoCell :: Bool -> Maybe Int -> Widget
|
||||||
|
lmsStatusInfoCell extendedInfo auditMonths =
|
||||||
|
[whamlet|$newline never
|
||||||
|
<p>
|
||||||
|
_{MsgTableLmsStatusTooltip auditMonths}
|
||||||
|
<p>
|
||||||
|
<dl .glossary>
|
||||||
|
$if extendedInfo
|
||||||
|
<dt>^{icon IconPlanned}
|
||||||
|
<dd>_{MsgLmsStatusPlanned}
|
||||||
|
<dt>^{icon IconNotificationSent}
|
||||||
|
<dd>_{MsgLmsStatusNotificationSent}
|
||||||
|
<dt>^{icon IconNotOK}
|
||||||
|
<dd>_{MsgLmsStatusBlocked}
|
||||||
|
<dt>^{icon IconExpired}
|
||||||
|
<dd>_{MsgLmsStatusExpired}
|
||||||
|
<dt>^{icon IconOK}
|
||||||
|
<dd>_{MsgLmsStatusSuccess}
|
||||||
|
<p>
|
||||||
|
_{MsgLmsStatusDelay}
|
||||||
|
|]
|
||||||
|
|
||||||
lmsStatusIcon :: LmsStatus -> Icon
|
lmsStatusIcon :: LmsStatus -> Icon
|
||||||
lmsStatusIcon LmsSuccess{} = IconOK
|
lmsStatusIcon LmsSuccess{} = IconOK
|
||||||
lmsStatusIcon LmsExpired{} = IconExpired
|
lmsStatusIcon LmsExpired{} = IconExpired
|
||||||
lmsStatusIcon _other = IconNotOK
|
lmsStatusIcon _other = IconNotOK
|
||||||
|
|
||||||
lmsUserStatusWidget :: LmsUser -> Widget
|
lmsUserStatusWidget :: Bool -> LmsUser -> Widget
|
||||||
lmsUserStatusWidget LmsUser{lmsUserStatus=Just lStat} =
|
lmsUserStatusWidget _ LmsUser{lmsUserStatus=Just lStat} =
|
||||||
[whamlet|$newline never
|
[whamlet|$newline never
|
||||||
^{formatTimeW SelFormatDate (lmsStatusDay lStat)}
|
^{formatTimeW SelFormatDate (lmsStatusDay lStat)}
|
||||||
\ ^{icon (lmsStatusIcon lStat)}
|
\ ^{icon (lmsStatusIcon lStat)}
|
||||||
|]
|
|]
|
||||||
lmsUserStatusWidget LmsUser{lmsUserStarted} =
|
-- previously: IconWaitingForUser for lmsUserStatus==Nothing
|
||||||
|
lmsUserStatusWidget _ LmsUser{lmsUserNotified=Just d} =
|
||||||
[whamlet|$newline never
|
[whamlet|$newline never
|
||||||
^{formatTimeW SelFormatDate lmsUserStarted}
|
^{formatTimeW SelFormatDate d}
|
||||||
\ ^{icon IconWaitingForUser}
|
\ ^{icon IconNotificationSent}
|
||||||
|]
|
|]
|
||||||
|
lmsUserStatusWidget True LmsUser{lmsUserStarted} = -- E-Learning started, but not yet notified; only intended for Admins
|
||||||
|
[whamlet|$newline never
|
||||||
|
^{formatTimeW SelFormatDate lmsUserStarted}
|
||||||
|
\ ^{icon IconPlanned}
|
||||||
|
|]
|
||||||
|
lmsUserStatusWidget _ _ = mempty
|
||||||
|
|||||||
@ -7,6 +7,7 @@ module Handler.Utils.Table.Cells where
|
|||||||
import Import hiding (link)
|
import Import hiding (link)
|
||||||
|
|
||||||
import Text.Blaze (ToMarkup(..))
|
import Text.Blaze (ToMarkup(..))
|
||||||
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
import Handler.Utils.Table.Pagination
|
import Handler.Utils.Table.Pagination
|
||||||
import Handler.Utils.DateTime
|
import Handler.Utils.DateTime
|
||||||
@ -217,6 +218,16 @@ cellHasUserModal toLink user =
|
|||||||
cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
||||||
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
|
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
|
||||||
|
|
||||||
|
cellHasMatrikelnummerLinked :: (IsDBTable m a, HasEntity u User) => u -> DBCell m a
|
||||||
|
cellHasMatrikelnummerLinked usr
|
||||||
|
| Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do
|
||||||
|
uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey
|
||||||
|
modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid)
|
||||||
|
| otherwise = mempty
|
||||||
|
where
|
||||||
|
usrEntity = usr ^. hasEntityUser
|
||||||
|
|
||||||
|
|
||||||
cellHasEMail :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
cellHasEMail :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
||||||
cellHasEMail = emailCell . view _userDisplayEmail
|
cellHasEMail = emailCell . view _userDisplayEmail
|
||||||
|
|
||||||
@ -356,15 +367,15 @@ cryptoidCell = addCellClass ("cryptoid" :: Text) . textCell . toPathPiece
|
|||||||
lmsStatusCell :: IsDBTable m a => LmsStatus -> DBCell m a
|
lmsStatusCell :: IsDBTable m a => LmsStatus -> DBCell m a
|
||||||
lmsStatusCell ls = iconCell (lmsStatusIcon ls) <> spacerCell <> dayCell (lmsStatusDay ls)
|
lmsStatusCell ls = iconCell (lmsStatusIcon ls) <> spacerCell <> dayCell (lmsStatusDay ls)
|
||||||
|
|
||||||
lmsStatusPlusCell :: IsDBTable m a => LmsUser -> DBCell m a
|
-- lmsStatusPlusCell :: IsDBTable m a => LmsUser -> DBCell m a
|
||||||
lmsStatusPlusCell LmsUser{lmsUserStatus=Just lStat} = lmsStatusCell lStat
|
-- lmsStatusPlusCell LmsUser{lmsUserStatus=Just lStat} = lmsStatusCell lStat
|
||||||
lmsStatusPlusCell LmsUser{lmsUserStarted} = iconCell IconWaitingForUser <> spacerCell <> dateCell lmsUserStarted
|
-- lmsStatusPlusCell LmsUser{lmsUserStarted} = iconCell IconWaitingForUser <> spacerCell <> dateCell lmsUserStarted
|
||||||
|
|
||||||
lmsStatusPlusCell' :: IsDBTable m a => Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> DBCell m a
|
lmsStatusPlusCell :: IsDBTable m a => Maybe (CryptoUUIDUser -> Route UniWorX) -> LmsUser -> DBCell m a
|
||||||
lmsStatusPlusCell' Nothing lu = wgtCell $ lmsUserStatusWidget lu
|
lmsStatusPlusCell Nothing lu = wgtCell $ lmsUserStatusWidget False lu
|
||||||
lmsStatusPlusCell' (Just toLink) lu = cell $ do
|
lmsStatusPlusCell (Just toLink) lu = cell $ do
|
||||||
uuid <- liftHandler $ encrypt $ lu ^. _lmsUserUser
|
uuid <- liftHandler $ encrypt $ lu ^. _lmsUserUser
|
||||||
modal (lmsUserStatusWidget lu) (Left $ SomeRoute $ toLink uuid)
|
modal (lmsUserStatusWidget True lu) (Left $ SomeRoute $ toLink uuid)
|
||||||
|
|
||||||
qualificationBlockedCellNoReason :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
|
qualificationBlockedCellNoReason :: IsDBTable m a => Maybe QualificationBlocked -> DBCell m a
|
||||||
qualificationBlockedCellNoReason Nothing = mempty
|
qualificationBlockedCellNoReason Nothing = mempty
|
||||||
@ -379,5 +390,23 @@ qualificationBlockedCell (Just QualificationBlocked{..})
|
|||||||
where
|
where
|
||||||
mkCellWith c = c qualificationBlockedReason <> spacerCell <> iconCell IconBlocked <> spacerCell <> dayCell qualificationBlockedDay
|
mkCellWith c = c qualificationBlockedReason <> spacerCell <> iconCell IconBlocked <> spacerCell <> dayCell qualificationBlockedDay
|
||||||
|
|
||||||
avsPersonNoCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
|
avsPersonNoCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
|
||||||
avsPersonNoCell = numCell . view _userAvsNoPerson
|
avsPersonNoCell = numCell . view _userAvsNoPerson
|
||||||
|
|
||||||
|
avsPersonNoLinkedCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
|
||||||
|
avsPersonNoLinkedCell a = cell $ do
|
||||||
|
uuid <- liftHandler $ encrypt $ a ^. _userAvsUser
|
||||||
|
modal (toWgt $ toMessage $ a ^. _userAvsNoPerson) (Left $ SomeRoute $ AdminAvsUserR uuid)
|
||||||
|
|
||||||
|
avsPersonCardCell :: (IsDBTable m c) => Set AvsDataPersonCard -> DBCell m c
|
||||||
|
avsPersonCardCell cards = wgtCell
|
||||||
|
[whamlet|
|
||||||
|
$newline never
|
||||||
|
<ul .list--iconless .list--inline .list--comma-separated>
|
||||||
|
$forall c <- validColors
|
||||||
|
<li>
|
||||||
|
_{c}
|
||||||
|
|]
|
||||||
|
where
|
||||||
|
validCards = Set.filter avsDataValid cards
|
||||||
|
validColors = Set.toDescList $ Set.map avsDataCardColor validCards
|
||||||
@ -442,8 +442,8 @@ fltrUserMatriculationUI :: DBFilterUI
|
|||||||
fltrUserMatriculationUI mPrev = prismAForm (singletonFilter "user-matriculation") mPrev $ aopt textField (fslI MsgTableUserMatriculation)
|
fltrUserMatriculationUI mPrev = prismAForm (singletonFilter "user-matriculation") mPrev $ aopt textField (fslI MsgTableUserMatriculation)
|
||||||
|
|
||||||
|
|
||||||
colUserMatriclenr :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
|
colUserMatriclenr :: (IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c)
|
||||||
colUserMatriclenr = sortable (Just "user-matriclenumber") (i18nCell MsgTableMatrikelNr) cellHasMatrikelnummer
|
colUserMatriclenr = sortable (Just "user-matriclenumber") (i18nCell MsgTableMatrikelNr) cellHasMatrikelnummerLinked
|
||||||
|
|
||||||
sortUserMatriclenr :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')
|
sortUserMatriclenr :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')
|
||||||
sortUserMatriclenr queryUser = ("user-matriclenumber", SortColumn $ queryUser >>> (E.^. UserMatrikelnummer))
|
sortUserMatriclenr queryUser = ("user-matriclenumber", SortColumn $ queryUser >>> (E.^. UserMatrikelnummer))
|
||||||
|
|||||||
@ -48,7 +48,7 @@ module Handler.Utils.Table.Pagination
|
|||||||
, linkEitherCell, linkEitherCellM, linkEitherCellM'
|
, linkEitherCell, linkEitherCellM, linkEitherCellM'
|
||||||
, maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
|
, maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
|
||||||
, anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM'
|
, anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM'
|
||||||
, cellTooltip, cellTooltipIcon
|
, cellTooltip, cellTooltipIcon, cellTooltipWgt
|
||||||
, listCell, listCell', listCellOf, listCellOf'
|
, listCell, listCell', listCellOf, listCellOf'
|
||||||
, ilistCell, ilistCell', ilistCellOf, ilistCellOf'
|
, ilistCell, ilistCell', ilistCellOf, ilistCellOf'
|
||||||
, formCell, DBFormResult(..), getDBFormResult
|
, formCell, DBFormResult(..), getDBFormResult
|
||||||
@ -1700,9 +1700,12 @@ cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a -
|
|||||||
cellTooltip = cellTooltipIcon Nothing
|
cellTooltip = cellTooltipIcon Nothing
|
||||||
|
|
||||||
cellTooltipIcon :: (RenderMessage UniWorX msg, IsDBTable m a) => Maybe Icon -> msg -> DBCell m a -> DBCell m a
|
cellTooltipIcon :: (RenderMessage UniWorX msg, IsDBTable m a) => Maybe Icon -> msg -> DBCell m a -> DBCell m a
|
||||||
cellTooltipIcon icn msg = cellContents.mapped %~ (<> tipWdgt)
|
cellTooltipIcon icn = cellTooltipWgt icn . msg2widget
|
||||||
|
|
||||||
|
cellTooltipWgt :: (IsDBTable m a) => Maybe Icon -> Widget-> DBCell m a -> DBCell m a
|
||||||
|
cellTooltipWgt icn wgt = cellContents.mapped %~ (<> tipWdgt)
|
||||||
where
|
where
|
||||||
tipWdgt = iconTooltip (msg2widget msg) icn True
|
tipWdgt = iconTooltip wgt icn True
|
||||||
|
|
||||||
-- | Always display widget; maybe a link if user is Authorized.
|
-- | Always display widget; maybe a link if user is Authorized.
|
||||||
-- Also see variant `linkEmptyCell`
|
-- Also see variant `linkEmptyCell`
|
||||||
|
|||||||
@ -13,7 +13,7 @@ import Text.Hamlet (shamletFile)
|
|||||||
import Handler.Utils.DateTime
|
import Handler.Utils.DateTime
|
||||||
|
|
||||||
import qualified Data.Char as Char
|
import qualified Data.Char as Char
|
||||||
|
import qualified Data.HashMap.Strict as Aeson -- ON UPDATE replace with: import qualified Data.Aeson.KeyMap as Aeson
|
||||||
|
|
||||||
---------
|
---------
|
||||||
-- Simple utilities for consistent display
|
-- Simple utilities for consistent display
|
||||||
@ -198,3 +198,36 @@ roomReferenceWidget RoomReferenceLink{..} = $(widgetFile "widgets/room-reference
|
|||||||
where
|
where
|
||||||
linkText = uriToString id roomRefLink mempty
|
linkText = uriToString id roomRefLink mempty
|
||||||
instrModal = modal (i18n MsgRoomReferenceLinkInstructions) $ Right $(widgetFile "widgets/room-reference/link-instructions-modal")
|
instrModal = modal (i18n MsgRoomReferenceLinkInstructions) $ Right $(widgetFile "widgets/room-reference/link-instructions-modal")
|
||||||
|
|
||||||
|
|
||||||
|
----------
|
||||||
|
-- JSON --
|
||||||
|
----------
|
||||||
|
|
||||||
|
-- Data.Aeson.Encode.Pretty.encodePretty did not render in Html properly, hence jsonWidget
|
||||||
|
jsonWidget :: ToJSON a => a -> Widget
|
||||||
|
jsonWidget x = jsonWidgetAux $ toJSON x
|
||||||
|
where
|
||||||
|
jsonWidgetAux :: Value -> Widget
|
||||||
|
jsonWidgetAux Null = [whamlet|Null|]
|
||||||
|
jsonWidgetAux (Bool b) = toWidget $ boolSymbol b
|
||||||
|
jsonWidgetAux (String s) = [whamlet|#{s}|]
|
||||||
|
jsonWidgetAux (Number n) = [whamlet|#{show n}|]
|
||||||
|
jsonWidgetAux (Array l)
|
||||||
|
| 1 >= length l = foldMap jsonWidgetAux l -- empty arrays don't show
|
||||||
|
| otherwise =
|
||||||
|
[whamlet|
|
||||||
|
<ul>
|
||||||
|
$forall x <- sort l
|
||||||
|
<li>^{jsonWidgetAux x}
|
||||||
|
|]
|
||||||
|
jsonWidgetAux (Object o) = case Aeson.toList o of -- toAscList not supported
|
||||||
|
[ ] -> mempty -- empty objects don't show
|
||||||
|
[(_,v)] -> jsonWidgetAux v
|
||||||
|
r -> [whamlet|
|
||||||
|
<dl .deflist>
|
||||||
|
$forall (k,v) <- sort r
|
||||||
|
<dt .deflist__dt>#{k}
|
||||||
|
<dd .deflist__dd>^{jsonWidgetAux v}
|
||||||
|
|]
|
||||||
|
|
||||||
@ -100,7 +100,7 @@ instance FromJSON AvsInternalPersonalNo where
|
|||||||
instance ToJSON AvsInternalPersonalNo where
|
instance ToJSON AvsInternalPersonalNo where
|
||||||
toJSON (AvsInternalPersonalNo ipn) = toJSON $ normalizeAvsInternalPersonalNo ipn
|
toJSON (AvsInternalPersonalNo ipn) = toJSON $ normalizeAvsInternalPersonalNo ipn
|
||||||
|
|
||||||
type instance Element AvsInternalPersonalNo = Char
|
type instance Element AvsInternalPersonalNo = Char
|
||||||
instance MonoFoldable AvsInternalPersonalNo where
|
instance MonoFoldable AvsInternalPersonalNo where
|
||||||
ofoldMap f = ofoldr (mappend . f) mempty . avsInternalPersonalNo
|
ofoldMap f = ofoldr (mappend . f) mempty . avsInternalPersonalNo
|
||||||
ofoldr x y = Text.foldr x y . avsInternalPersonalNo
|
ofoldr x y = Text.foldr x y . avsInternalPersonalNo
|
||||||
@ -207,7 +207,10 @@ instance ToJSON AvsPersonId where
|
|||||||
instance Show AvsPersonId where
|
instance Show AvsPersonId where
|
||||||
show = show . avsPersonId
|
show = show . avsPersonId
|
||||||
instance Read AvsPersonId where
|
instance Read AvsPersonId where
|
||||||
readPrec = fmap AvsPersonId readPrec
|
readPrec = fmap AvsPersonId readPrec
|
||||||
|
|
||||||
|
_AvsPersonId :: Iso AvsPersonId AvsPersonId Int Int
|
||||||
|
_AvsPersonId = iso avsPersonId AvsPersonId
|
||||||
|
|
||||||
-- | Non-existing default, also needed for query all ramp driving licences
|
-- | Non-existing default, also needed for query all ramp driving licences
|
||||||
avsPersonIdZero :: AvsPersonId
|
avsPersonIdZero :: AvsPersonId
|
||||||
@ -281,12 +284,13 @@ licence2char AvsLicenceRollfeld = 'R'
|
|||||||
data AvsDataCardColor = AvsCardColorMisc Text | AvsCardColorGrün | AvsCardColorBlau | AvsCardColorRot | AvsCardColorGelb
|
data AvsDataCardColor = AvsCardColorMisc Text | AvsCardColorGrün | AvsCardColorBlau | AvsCardColorRot | AvsCardColorGelb
|
||||||
deriving (Eq, Ord, Read, Show, Generic)
|
deriving (Eq, Ord, Read, Show, Generic)
|
||||||
deriving anyclass (NFData)
|
deriving anyclass (NFData)
|
||||||
|
-- instance RenderMessage declared in Foundation.I18n
|
||||||
|
|
||||||
instance ToJSON AvsDataCardColor where
|
instance ToJSON AvsDataCardColor where
|
||||||
toJSON AvsCardColorGrün = "Grün"
|
toJSON AvsCardColorGrün = "Grün"
|
||||||
toJSON AvsCardColorBlau = "Blau"
|
toJSON AvsCardColorBlau = "Blau"
|
||||||
toJSON AvsCardColorRot = "Rot"
|
toJSON AvsCardColorRot = "Rot"
|
||||||
toJSON AvsCardColorGelb = "Gelb"
|
toJSON AvsCardColorGelb = "Gelb"
|
||||||
toJSON (AvsCardColorMisc t) = String t
|
toJSON (AvsCardColorMisc t) = String t
|
||||||
|
|
||||||
instance FromJSON AvsDataCardColor where
|
instance FromJSON AvsDataCardColor where
|
||||||
@ -657,7 +661,7 @@ deriveJSON defaultOptions
|
|||||||
} ''AvsQueryPerson
|
} ''AvsQueryPerson
|
||||||
|
|
||||||
newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId)
|
newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId)
|
||||||
deriving (Eq, Ord, Show, Generic)
|
deriving (Eq, Ord, Show, Generic)
|
||||||
deriveJSON defaultOptions ''AvsQueryStatus
|
deriveJSON defaultOptions ''AvsQueryStatus
|
||||||
|
|
||||||
newtype AvsQueryContact = AvsQueryContact (Set AvsObjPersonId) -- note the difference to AvsQueryStatus, which receives a list of id, whereas here we sent a list of single-field object
|
newtype AvsQueryContact = AvsQueryContact (Set AvsObjPersonId) -- note the difference to AvsQueryStatus, which receives a list of id, whereas here we sent a list of single-field object
|
||||||
|
|||||||
@ -68,7 +68,7 @@ mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
|
|||||||
mkAvsQuery _ _ _ = AvsQuery
|
mkAvsQuery _ _ _ = AvsQuery
|
||||||
{ avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty
|
{ avsQueryPerson = \_ -> return . Right $ AvsResponsePerson mempty
|
||||||
, avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty
|
, avsQueryStatus = \_ -> return . Right $ AvsResponseStatus mempty
|
||||||
, avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "AVSNO:123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
|
, avsQueryContact = \_ -> return . Right $ AvsResponseContact $ Set.singleton $ AvsDataContact (AvsPersonId 1234567) (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing Nothing Nothing Nothing) (AvsFirmInfo "Lange Firma" 7 "Kurz" Nothing Nothing Nothing Nothing Nothing Nothing)
|
||||||
, avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty
|
, avsQuerySetLicences = \_ -> return . Right $ AvsResponseSetLicences mempty
|
||||||
, avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty
|
, avsQueryGetAllLicences = return . Right $ AvsResponseGetLicences mempty
|
||||||
}
|
}
|
||||||
|
|||||||
@ -68,11 +68,14 @@ data Icon
|
|||||||
| IconRegisterTemplate
|
| IconRegisterTemplate
|
||||||
| IconNoCorrectors
|
| IconNoCorrectors
|
||||||
| IconTooltipDefault
|
| IconTooltipDefault
|
||||||
| IconNotificationSuccess
|
| IconNotificationSuccess -- used for popups
|
||||||
| IconNotificationInfo
|
| IconNotificationInfo
|
||||||
| IconNotificationWarning
|
| IconNotificationWarning
|
||||||
| IconNotificationError
|
| IconNotificationError
|
||||||
| IconNotificationNonactive
|
| IconNotificationNonactive
|
||||||
|
| IconNotification -- used for email and lettes
|
||||||
|
| IconNoNotification
|
||||||
|
| IconNotificationSent
|
||||||
| IconFavourite
|
| IconFavourite
|
||||||
| IconLanguage
|
| IconLanguage
|
||||||
| IconNavContainerClose | IconPageActionChildrenClose
|
| IconNavContainerClose | IconPageActionChildrenClose
|
||||||
@ -93,7 +96,6 @@ data Icon
|
|||||||
| IconFileUploadSession
|
| IconFileUploadSession
|
||||||
| IconStandaloneFieldError
|
| IconStandaloneFieldError
|
||||||
| IconFileUser
|
| IconFileUser
|
||||||
| IconNotification | IconNoNotification
|
|
||||||
| IconPersonalIdentification
|
| IconPersonalIdentification
|
||||||
| IconMenuWorkflows
|
| IconMenuWorkflows
|
||||||
| IconVideo
|
| IconVideo
|
||||||
@ -106,7 +108,7 @@ data Icon
|
|||||||
| IconLetter
|
| IconLetter
|
||||||
| IconAt
|
| IconAt
|
||||||
| IconSupervisor
|
| IconSupervisor
|
||||||
| IconWaitingForUser
|
-- | IconWaitingForUser
|
||||||
| IconExpired
|
| IconExpired
|
||||||
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
|
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
|
||||||
deriving anyclass (Universe, Finite, NFData)
|
deriving anyclass (Universe, Finite, NFData)
|
||||||
@ -180,6 +182,7 @@ iconText = \case
|
|||||||
IconStandaloneFieldError -> "exclamation"
|
IconStandaloneFieldError -> "exclamation"
|
||||||
IconFileUser -> "file-user"
|
IconFileUser -> "file-user"
|
||||||
IconNotification -> "envelope"
|
IconNotification -> "envelope"
|
||||||
|
IconNotificationSent -> "envelope-open" -- "paper-plane", "shipping-fast", "hourglass-half"
|
||||||
IconNoNotification -> "bell-slash"
|
IconNoNotification -> "bell-slash"
|
||||||
IconPersonalIdentification -> "id-card"
|
IconPersonalIdentification -> "id-card"
|
||||||
IconMenuWorkflows -> "project-diagram"
|
IconMenuWorkflows -> "project-diagram"
|
||||||
@ -192,7 +195,7 @@ iconText = \case
|
|||||||
IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well
|
IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well
|
||||||
IconAt -> "at"
|
IconAt -> "at"
|
||||||
IconSupervisor -> "head-side" -- must be notably different to user
|
IconSupervisor -> "head-side" -- must be notably different to user
|
||||||
IconWaitingForUser -> "user-cog" -- Waiting on a user to do something
|
-- IconWaitingForUser -> "user-cog" -- Waiting on a user to do something
|
||||||
IconExpired -> "hourglass-end"
|
IconExpired -> "hourglass-end"
|
||||||
|
|
||||||
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
||||||
|
|||||||
@ -34,7 +34,7 @@ $else
|
|||||||
<dd .deflist__dd>^{formatTimeW SelFormatDateTime (lmsUserStarted lmsUsr)}
|
<dd .deflist__dd>^{formatTimeW SelFormatDateTime (lmsUserStarted lmsUsr)}
|
||||||
$maybe _ <- lmsUserStatus lmsUsr
|
$maybe _ <- lmsUserStatus lmsUsr
|
||||||
<dt .deflist__dt>_{MsgTableLmsStatus}
|
<dt .deflist__dt>_{MsgTableLmsStatus}
|
||||||
<dd .deflist__dd>^{lmsUserStatusWidget lmsUsr}
|
<dd .deflist__dd>^{lmsUserStatusWidget True lmsUsr}
|
||||||
<dt .deflist__dt>_{MsgTableLmsIdent}
|
<dt .deflist__dt>_{MsgTableLmsIdent}
|
||||||
<dd .deflist__dd .email>#{getLmsIdent (lmsUserIdent lmsUsr)}
|
<dd .deflist__dd .email>#{getLmsIdent (lmsUserIdent lmsUsr)}
|
||||||
<dt .deflist__dt>_{MsgTableLmsPin}
|
<dt .deflist__dt>_{MsgTableLmsPin}
|
||||||
|
|||||||
@ -163,7 +163,7 @@ fillDb = do
|
|||||||
, userAuthentication = pwSimple
|
, userAuthentication = pwSimple
|
||||||
, userLastAuthentication = Nothing
|
, userLastAuthentication = Nothing
|
||||||
, userTokensIssuedAfter = Nothing
|
, userTokensIssuedAfter = Nothing
|
||||||
, userMatrikelnummer = Nothing
|
, userMatrikelnummer = Just "94094094094"
|
||||||
, userEmail = "e12345@fraport.de"
|
, userEmail = "e12345@fraport.de"
|
||||||
, userDisplayEmail = "jost@tcs.ifi.lmu.de"
|
, userDisplayEmail = "jost@tcs.ifi.lmu.de"
|
||||||
, userDisplayName = "Steffen Jost"
|
, userDisplayName = "Steffen Jost"
|
||||||
@ -358,7 +358,126 @@ fillDb = do
|
|||||||
, userExamOfficeGetSynced = False
|
, userExamOfficeGetSynced = False
|
||||||
, userExamOfficeGetLabels = True
|
, userExamOfficeGetLabels = True
|
||||||
}
|
}
|
||||||
|
_stranger1 <- insert User
|
||||||
|
{ userIdent = "AVSID:996699"
|
||||||
|
, userAuthentication = AuthLDAP
|
||||||
|
, userLastAuthentication = Nothing
|
||||||
|
, userTokensIssuedAfter = Nothing
|
||||||
|
, userMatrikelnummer = Nothing
|
||||||
|
, userEmail = "E996699@fraport.de"
|
||||||
|
, userDisplayEmail = ""
|
||||||
|
, userDisplayName = "Stranger One"
|
||||||
|
, userSurname = "One"
|
||||||
|
, userFirstName = "Stranger"
|
||||||
|
, userTitle = Nothing
|
||||||
|
, userMaxFavourites = userDefaultMaxFavourites
|
||||||
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
||||||
|
, userTheme = ThemeMossGreen
|
||||||
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
|
, userDateFormat = userDefaultDateFormat
|
||||||
|
, userTimeFormat = userDefaultTimeFormat
|
||||||
|
, userDownloadFiles = userDefaultDownloadFiles
|
||||||
|
, userWarningDays = userDefaultWarningDays
|
||||||
|
, userLanguages = Nothing
|
||||||
|
, userNotificationSettings = def
|
||||||
|
, userCreated = now
|
||||||
|
, userLastLdapSynchronisation = Nothing
|
||||||
|
, userLdapPrimaryKey = Nothing
|
||||||
|
, userCsvOptions = def
|
||||||
|
, userSex = Just SexMale
|
||||||
|
, userBirthday = Nothing
|
||||||
|
, userShowSex = userDefaultShowSex
|
||||||
|
, userTelephone = Nothing
|
||||||
|
, userMobile = Nothing
|
||||||
|
, userCompanyPersonalNumber = Just "E996699"
|
||||||
|
, userCompanyDepartment = Just "AVN-Strange"
|
||||||
|
, userPinPassword = Nothing
|
||||||
|
, userPostAddress = Nothing
|
||||||
|
, userPostLastUpdate = Nothing
|
||||||
|
, userPrefersPostal = False
|
||||||
|
, userExamOfficeGetSynced = False
|
||||||
|
, userExamOfficeGetLabels = True
|
||||||
|
}
|
||||||
|
_stranger2 <- insert User
|
||||||
|
{ userIdent = "AVSID:669966"
|
||||||
|
, userAuthentication = AuthLDAP
|
||||||
|
, userLastAuthentication = Nothing
|
||||||
|
, userTokensIssuedAfter = Nothing
|
||||||
|
, userMatrikelnummer = Nothing
|
||||||
|
, userEmail = "E669966@fraport.de"
|
||||||
|
, userDisplayEmail = ""
|
||||||
|
, userDisplayName = "Stranger Two"
|
||||||
|
, userSurname = "Stranger"
|
||||||
|
, userFirstName = "Two"
|
||||||
|
, userTitle = Nothing
|
||||||
|
, userMaxFavourites = userDefaultMaxFavourites
|
||||||
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
||||||
|
, userTheme = ThemeMossGreen
|
||||||
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
|
, userDateFormat = userDefaultDateFormat
|
||||||
|
, userTimeFormat = userDefaultTimeFormat
|
||||||
|
, userDownloadFiles = userDefaultDownloadFiles
|
||||||
|
, userWarningDays = userDefaultWarningDays
|
||||||
|
, userLanguages = Nothing
|
||||||
|
, userNotificationSettings = def
|
||||||
|
, userCreated = now
|
||||||
|
, userLastLdapSynchronisation = Nothing
|
||||||
|
, userLdapPrimaryKey = Nothing
|
||||||
|
, userCsvOptions = def
|
||||||
|
, userSex = Just SexMale
|
||||||
|
, userBirthday = Nothing
|
||||||
|
, userShowSex = userDefaultShowSex
|
||||||
|
, userTelephone = Nothing
|
||||||
|
, userMobile = Nothing
|
||||||
|
, userCompanyPersonalNumber = Just "669966"
|
||||||
|
, userCompanyDepartment = Just "AVN-Strange"
|
||||||
|
, userPinPassword = Nothing
|
||||||
|
, userPostAddress = Nothing
|
||||||
|
, userPostLastUpdate = Nothing
|
||||||
|
, userPrefersPostal = False
|
||||||
|
, userExamOfficeGetSynced = False
|
||||||
|
, userExamOfficeGetLabels = True
|
||||||
|
}
|
||||||
|
_stranger3 <- insert User
|
||||||
|
{ userIdent = "AVSID:6969"
|
||||||
|
, userAuthentication = AuthLDAP
|
||||||
|
, userLastAuthentication = Nothing
|
||||||
|
, userTokensIssuedAfter = Nothing
|
||||||
|
, userMatrikelnummer = Nothing
|
||||||
|
, userEmail = "E6969@fraport.de"
|
||||||
|
, userDisplayEmail = ""
|
||||||
|
, userDisplayName = "Stranger 3 Three"
|
||||||
|
, userSurname = "Three"
|
||||||
|
, userFirstName = "Stranger"
|
||||||
|
, userTitle = Nothing
|
||||||
|
, userMaxFavourites = userDefaultMaxFavourites
|
||||||
|
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
||||||
|
, userTheme = ThemeMossGreen
|
||||||
|
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||||
|
, userDateFormat = userDefaultDateFormat
|
||||||
|
, userTimeFormat = userDefaultTimeFormat
|
||||||
|
, userDownloadFiles = userDefaultDownloadFiles
|
||||||
|
, userWarningDays = userDefaultWarningDays
|
||||||
|
, userLanguages = Nothing
|
||||||
|
, userNotificationSettings = def
|
||||||
|
, userCreated = now
|
||||||
|
, userLastLdapSynchronisation = Nothing
|
||||||
|
, userLdapPrimaryKey = Nothing
|
||||||
|
, userCsvOptions = def
|
||||||
|
, userSex = Just SexMale
|
||||||
|
, userBirthday = Nothing
|
||||||
|
, userShowSex = userDefaultShowSex
|
||||||
|
, userTelephone = Nothing
|
||||||
|
, userMobile = Nothing
|
||||||
|
, userCompanyPersonalNumber = Just "E996699"
|
||||||
|
, userCompanyDepartment = Just "AVN-Strange"
|
||||||
|
, userPinPassword = Nothing
|
||||||
|
, userPostAddress = Just $ markdownToStoredMarkup ("Kartoffelweg 12 \n666 Höllensumpf \nFreiland"::Text)
|
||||||
|
, userPostLastUpdate = Nothing
|
||||||
|
, userPrefersPostal = False
|
||||||
|
, userExamOfficeGetSynced = False
|
||||||
|
, userExamOfficeGetLabels = True
|
||||||
|
}
|
||||||
let
|
let
|
||||||
firstNames = [ "James", "John", "Robert", "Michael"
|
firstNames = [ "James", "John", "Robert", "Michael"
|
||||||
, "William", "David", "Mary", "Richard"
|
, "William", "David", "Mary", "Richard"
|
||||||
@ -419,8 +538,8 @@ fillDb = do
|
|||||||
, userShowSex = userDefaultShowSex
|
, userShowSex = userDefaultShowSex
|
||||||
, userTelephone = Nothing
|
, userTelephone = Nothing
|
||||||
, userMobile = Nothing
|
, userMobile = Nothing
|
||||||
, userCompanyPersonalNumber = Nothing
|
, userCompanyPersonalNumber = bool Nothing (Just "E123" ) (even $ length firstName)
|
||||||
, userCompanyDepartment = Nothing
|
, userCompanyDepartment = bool Nothing (Just "AVN-A") (even $ length userSurname)
|
||||||
, userPinPassword = Nothing
|
, userPinPassword = Nothing
|
||||||
, userPostAddress = Nothing
|
, userPostAddress = Nothing
|
||||||
, userPostLastUpdate = Nothing
|
, userPostLastUpdate = Nothing
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user