Merge branch 'master' into 476-interface-fur-klausurkorrekturen
This commit is contained in:
Sarah Vaupel
commit
36e90102c4
1
.gitignore
vendored
1
.gitignore
vendored
@ -38,4 +38,5 @@ test.log
|
||||
tunnel.log
|
||||
/static
|
||||
/well-known
|
||||
/.well-known-cache
|
||||
/**/tmp-*
|
||||
|
||||
@ -6,6 +6,7 @@ default:
|
||||
- node_modules
|
||||
- .stack
|
||||
- .stack-work
|
||||
- .well-known-cache
|
||||
|
||||
variables:
|
||||
STACK_ROOT: "${CI_PROJECT_DIR}/.stack"
|
||||
@ -13,6 +14,7 @@ variables:
|
||||
POSTGRES_DB: uniworx_test
|
||||
POSTGRES_USER: uniworx
|
||||
POSTGRES_PASSWORD: uniworx
|
||||
N_PREFIX: "${HOME}/.n"
|
||||
|
||||
stages:
|
||||
- setup
|
||||
@ -30,7 +32,8 @@ npm install:
|
||||
before_script: &npm
|
||||
- apt-get update -y
|
||||
- npm install -g n
|
||||
- n stable
|
||||
- n 13.5.0
|
||||
- export PATH="${N_PREFIX}/bin:$PATH"
|
||||
- npm install -g npm
|
||||
- hash -r
|
||||
- apt-get -y install openssh-client exiftool
|
||||
@ -138,7 +141,8 @@ frontend:test:
|
||||
before_script:
|
||||
- apt-get update -y
|
||||
- npm install -g n
|
||||
- n stable
|
||||
- n 13.5.0
|
||||
- export PATH="${N_PREFIX}/bin:$PATH"
|
||||
- npm install -g npm
|
||||
- hash -r
|
||||
- apt-get install -y --no-install-recommends chromium-browser
|
||||
|
||||
48
CHANGELOG.md
48
CHANGELOG.md
@ -2,6 +2,54 @@
|
||||
|
||||
All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
|
||||
|
||||
### [10.4.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v10.4.0...v10.4.1) (2020-01-17)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* hlint ([4348efc](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/4348efc))
|
||||
|
||||
|
||||
|
||||
## [10.4.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v10.3.0...v10.4.0) (2020-01-17)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* add missing translations ([d798dc4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d798dc4))
|
||||
* improve csv import explanation ([729a8e8](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/729a8e8))
|
||||
* restrict guessUser to consistent queries ([bcd5326](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bcd5326))
|
||||
* tests & hlint ([4e9b618](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/4e9b618))
|
||||
* ui improvements for (external-)exams ([b3ce3dd](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b3ce3dd))
|
||||
* **hide-columns:** bump storage manager minor version ([9053b87](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9053b87))
|
||||
* **hide-columns:** no hide-columns in tail.datetime ([03bcf56](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/03bcf56))
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* course-participant-lists ([88dd5a9](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/88dd5a9))
|
||||
* external exam csv export ([553c117](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/553c117))
|
||||
* external exam csv import & ldap lookup during csv import ([1d14b6a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1d14b6a))
|
||||
* external exams in exam office exams table ([3b739f7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3b739f7))
|
||||
* notification about externalExamResults to exam-office ([a304840](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a304840))
|
||||
* **external-exams:** auditing ([2b153c1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/2b153c1))
|
||||
* **external-exams:** create new exams ([94bb391](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/94bb391))
|
||||
* **external-exams:** display staff & add' schools ([c14d90f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c14d90f))
|
||||
* **external-exams:** edit existing exams ([1252a5f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1252a5f))
|
||||
* **external-exams:** list ([fa3521d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fa3521d))
|
||||
* **external-exams:** plan for student grade access ([b7506a0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b7506a0))
|
||||
* **external-exams:** requisite routes ([f25b21a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f25b21a))
|
||||
* **hide-columns:** add hider label th attr ([6c05a8f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6c05a8f))
|
||||
* **hide-columns:** add hider label th attr ([71e90a1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/71e90a1))
|
||||
* **hide-columns:** add hider labels for material list ([ccafd95](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ccafd95))
|
||||
* **hide-columns:** add hider labels for tutorial list on course page ([3553df2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3553df2))
|
||||
* **hide-columns:** add hider labels for tutorial list on course page ([03e4ac1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/03e4ac1))
|
||||
* **hide-columns:** add more hider labels ([555c4ae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/555c4ae))
|
||||
* **hide-columns:** add more hider labels ([eba58d8](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/eba58d8))
|
||||
* **hide-columns:** opt-out on select columns ([b03c10f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b03c10f))
|
||||
|
||||
|
||||
|
||||
## [10.3.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v10.2.0...v10.3.0) (2020-01-12)
|
||||
|
||||
|
||||
|
||||
@ -72,6 +72,5 @@
|
||||
},
|
||||
"settings": {
|
||||
"html_code_file": true
|
||||
},
|
||||
"versioning": false
|
||||
}
|
||||
}
|
||||
|
||||
@ -401,8 +401,10 @@ UnauthorizedToken404: Authorisierungs-Tokens können nicht auf Fehlerseiten ausg
|
||||
UnauthorizedSiteAdmin: Sie sind kein System-weiter Administrator.
|
||||
UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen.
|
||||
UnauthorizedAdminEscalation: Sie sind nicht Administrator für alle Institute, für die dieser Nutzer Administrator oder Veranstalter ist.
|
||||
UnauthorizedExamOffice: Sie sind nicht Teil eines Prüfungsamts.
|
||||
UnauthorizedExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie Teil eines assoziierten Prüfungsamts sind.
|
||||
UnauthorizedExamOffice: Sie sind nicht mit Prüfungsverwaltung beauftragt.
|
||||
UnauthorizedExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie mit der Prüfungsverwaltung beauftragt sind.
|
||||
UnauthorizedExternalExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie mit der Prüfungsverwaltung beauftragt sind.
|
||||
UnauthorizedEvaluation: Sie sind nicht mit der Kursumfragenverwaltung beauftragt.
|
||||
UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen.
|
||||
UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen.
|
||||
UnauthorizedAllocationLecturer: Sie sind nicht als Veranstalter für eine Veranstaltung dieser Zentralanmeldung eingetragen.
|
||||
@ -414,6 +416,7 @@ UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung r
|
||||
UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert.
|
||||
UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
|
||||
UnauthorizedExamOccurrenceRegistration: Anmeldung zur Klausur erfolgt nicht inkl. Raum/Termin.
|
||||
UnauthorizedExternalExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
|
||||
UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
|
||||
UnauthorizedParticipantSelf: Sie sind kein Teilnehmer dieser Veranstaltung.
|
||||
UnauthorizedApplicant: Angegebener Benutzer hat sich nicht für diese Veranstaltung beworben.
|
||||
@ -450,6 +453,8 @@ UnauthorizedTutor: Sie sind nicht Tutor.
|
||||
UnauthorizedTutorialRegisterGroup: Sie sind bereits in einem Tutorium mit derselben Registrierungs-Gruppe.
|
||||
UnauthorizedLDAP: Angegebener Nutzer meldet sich nicht mit Campus-Kennung an.
|
||||
UnauthorizedPWHash: Angegebener Nutzer meldet sich nicht mit Uni2work-Kennung an.
|
||||
UnauthorizedExternalExamListNotEmpty: Liste von externen Prüfungen ist nicht leer
|
||||
UnauthorizedExternalExamLecturer: Sie sind nicht als Prüfer für diese externe Prüfung eingetragen
|
||||
|
||||
UnauthorizedPasswordResetToken: Dieses Authorisierungs-Token kann nicht mehr zum Passwort ändern benutzt werden
|
||||
|
||||
@ -714,6 +719,7 @@ LoginNecessary: Bitte melden Sie sich dazu vorher an!
|
||||
|
||||
InternalLdapError: Interner Fehler beim Campus-Login
|
||||
|
||||
CampusUserInvalidIdent: Konnte anhand des Campus-Logins keine eindeutige Identifikation
|
||||
CampusUserInvalidEmail: Konnte anhand des Campus-Logins keine EMail-Addresse ermitteln
|
||||
CampusUserInvalidDisplayName: Konnte anhand des Campus-Logins keinen vollen Namen ermitteln
|
||||
CampusUserInvalidGivenName: Konnte anhand des Campus-Logins keinen Vornamen ermitteln
|
||||
@ -862,6 +868,9 @@ MailExamOfficeExamResultsIntro courseName@Text termDesc@Text examn@ExamName: Ein
|
||||
MailSubjectExamOfficeExamResultsChanged csh@CourseShorthand examn@ExamName: Ergebnisse für #{examn} in #{csh} wurden verändert
|
||||
MailExamOfficeExamResultsChangedIntro courseName@Text termDesc@Text examn@ExamName: Ein Kursverwalter hat Prüfungsleistungen für #{examn} im Kurs #{courseName} (#{termDesc}) verändert.
|
||||
|
||||
MailSubjectExamOfficeExternalExamResults coursen@CourseName examn@ExamName: Ergebnisse für #{examn} in #{coursen}
|
||||
MailExamOfficeExternalExamResultsIntro coursen@CourseName termDesc@Text examn@ExamName: Ein Kursverwalter hat Prüfungsleistungen für #{examn} im Kurs #{coursen} (#{termDesc}) erstellt oder angepasst.
|
||||
|
||||
MailSubjectExamRegistrationActive csh@CourseShorthand examn@ExamName: Anmeldung für #{examn} in #{csh} ist möglich
|
||||
MailExamRegistrationActiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich nun für #{examn} im Kurs #{courseName} (#{termDesc}) anmelden.
|
||||
|
||||
@ -997,7 +1006,7 @@ NotificationTriggerKindCorrector: Für Korrektoren
|
||||
NotificationTriggerKindLecturer: Für Dozenten
|
||||
NotificationTriggerKindCourseLecturer: Für Kursverwalter
|
||||
NotificationTriggerKindAdmin: Für Administratoren
|
||||
NotificationTriggerKindExamOffice: Für das Prüfungsamt
|
||||
NotificationTriggerKindExamOffice: Für Prüfungsverwalter
|
||||
NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
|
||||
NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen (Dozenten)
|
||||
NotificationTriggerKindAllocationParticipant: Für Zentralanmeldungen
|
||||
@ -1124,7 +1133,7 @@ MenuCourseMembers: Kursteilnehmer
|
||||
MenuCourseAddMembers: Kursteilnehmer hinzufügen
|
||||
MenuCourseCommunication: Kursmitteilung (E-Mail)
|
||||
MenuCourseApplications: Bewerbungen
|
||||
MenuCourseExamOffice: Prüfungsämter
|
||||
MenuCourseExamOffice: Prüfungsbeauftragte
|
||||
MenuTermShow: Semester
|
||||
MenuSubmissionDelete: Abgabe löschen
|
||||
MenuUsers: Benutzer
|
||||
@ -1192,6 +1201,12 @@ MenuCourseNewsNew: Neue Kursnachricht
|
||||
MenuCourseNewsEdit: Kursnachricht bearbeiten
|
||||
MenuCourseEventNew: Neuer Kurstermin
|
||||
MenuCourseEventEdit: Kurstermin bearbeiten
|
||||
MenuExternalExamGrades: Prüfungsleistungen
|
||||
MenuExternalExamUsers: Teilnehmer
|
||||
MenuExternalExamEdit: Bearbeiten
|
||||
MenuExternalExamNew: Neue externe Prüfung
|
||||
MenuExternalExamList: Externe Prüfungen
|
||||
MenuParticipantsList: Kursteilnehmerlisten
|
||||
|
||||
BreadcrumbSubmissionFile: Datei
|
||||
BreadcrumbSubmissionUserInvite: Einladung zur Abgabe
|
||||
@ -1245,6 +1260,20 @@ BreadcrumbExamCorrect: Eintragen von Prüfungsergebnissen
|
||||
BreadcrumbApplicationFiles: Bewerbungsdateien
|
||||
BreadcrumbCourseNewsArchive: Archiv
|
||||
BreadcrumbCourseNewsFile: Datei
|
||||
BreadcrumbExternalExam: Externe Prüfung
|
||||
BreadcrumbExternalExamList: Externe Prüfungen
|
||||
BreadcrumbExternalExamNew: Neue externe Prüfung
|
||||
BreadcrumbExternalExamShow coursen@CourseName examn@ExamName: #{coursen}, #{examn}
|
||||
BreadcrumbExternalExamEdit: Editieren
|
||||
BreadcrumbExternalExamUsers: Teilnehmer
|
||||
BreadcrumbExternalExamGrades: Prüfungsleistungen
|
||||
BreadcrumbExternalExamStaffInvite: Einladung zum Prüfer
|
||||
BreadcrumbParticipantsList: Kursteilnehmerlisten
|
||||
BreadcrumbParticipants: Kursteilnehmerliste
|
||||
|
||||
ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
|
||||
ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}
|
||||
ExternalExamUsers coursen@CourseName examn@ExamName: Teilnehmer: #{coursen}, #{examn}
|
||||
|
||||
TitleMetrics: Metriken
|
||||
|
||||
@ -1253,7 +1282,8 @@ AuthPredsActive: Aktive Authorisierungsprädikate
|
||||
AuthPredsActiveChanged: Authorisierungseinstellungen für aktuelle Sitzung gespeichert
|
||||
AuthTagFree: Seite ist universell zugänglich
|
||||
AuthTagAdmin: Nutzer ist Administrator
|
||||
AuthTagExamOffice: Nutzer ist Teil eines Prüfungsamts
|
||||
AuthTagExamOffice: Nutzer ist mit Prüfungsverwaltung beauftragt
|
||||
AuthTagEvaluation: Nutzer ist mit Kursumfragenverwaltung beauftragt
|
||||
AuthTagToken: Nutzer präsentiert Authorisierungs-Token
|
||||
AuthTagNoEscalation: Nutzer-Rechte werden nicht auf fremde Institute ausgeweitet
|
||||
AuthTagDeprecated: Seite ist nicht überholt
|
||||
@ -1523,9 +1553,9 @@ ExamFinishedOffice: Noten bekannt gegeben
|
||||
ExamFinishedParticipant: Bewertung vorrausichtlich abgeschlossen
|
||||
ExamFinishedTip: Zeitpunkt zu dem Prüfungergebnisse den Teilnehmern gemeldet werden
|
||||
ExamClosed: Noten gemeldet
|
||||
ExamClosedTip: Prüfungsämter, die im System Noten einsehen, werden zu diesem Zeitpunkt benachrichtigt und danach bei Änderungen informiert
|
||||
ExamClosedTip: Prüfungsbeauftraget, die im System Noten einsehen, werden zu diesem Zeitpunkt benachrichtigt und danach bei Änderungen informiert
|
||||
ExamShowGrades: Klausur ist benotet
|
||||
ExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsämter nur informiert werden, ob die Klausur bestanden wurde?
|
||||
ExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsbeauftragte nur informiert werden, ob die Klausur bestanden wurde?
|
||||
ExamPublicStatistics: Statistik veröffentlichen
|
||||
ExamPublicStatisticsTip: Soll die automatisch berechnete statistische Auswertung auch den Teilnehmern angezeigt werden, sobald diese ihre Noten einsehen können?
|
||||
ExamAutomaticGrading: Automatische Notenberechnung
|
||||
@ -1545,6 +1575,7 @@ ExamBonusRule: Prüfungsbonus aus Übungsbetrieb
|
||||
ExamNoBonus': Kein automatischer Bonus
|
||||
ExamBonusPoints': Umrechnung von Übungspunkten
|
||||
ExamBonusManual': Manuelle Berechnung
|
||||
ExamGradesExplanation: Diese Ansicht zeigt die selben Daten an, wie die Tabelle von Prüfungsteilnehmern. Anpassen der Teilnehmerdaten und Ergebnisse ist nur dort möglich. Hier können Sie vor Allem einsehen und markieren, welche Prüfungsleistungen von den zuständigen Prüfungsbeauftragten bereits vollständig bearbeitet wurden.
|
||||
|
||||
ExamRegisterForOccurrence: Anmeldung zur Klausur erfolgt durch Anmeldung zu einem Termin/Raum
|
||||
|
||||
@ -1674,10 +1705,16 @@ ExamUserSyncTime: Zeitpunkt
|
||||
ExamUserSyncSchools: Institute
|
||||
ExamUserSyncLastChange: Zuletzt geändert
|
||||
ExamUserMarkSynchronised: Prüfungsleistung als synchronisiert markieren
|
||||
ExternalExamUserMarkSynchronised: Prüfungsleistung als synchronisiert markieren
|
||||
ExternalExamUserMarkSynchronisedTip: Sollen beim CSV-Export automatisch alle heruntergeladenen Prüfungsleistungen als synchronisiert markiert werden? Diese Markierung dient als Hinweis an andere Prüfungsbeauftragte und die Kursverwalter, dass die Leistung an der korrekten Stelle vermerkt wurde und keiner weiteren Handlung bedarf.
|
||||
|
||||
ExamUserMarkSynchronisedCsv: Prüfungsleistungen beim Export als synchronisiert markieren
|
||||
ExamUserMarkSynchronisedCsvTip: Sollen beim CSV-Export automatisch alle heruntergeladenen Prüfungsleistungen als synchronisiert markiert werden? Diese Markierung dient als Hinweis an andere Prüfungsbeauftragte und die Kursverwalter, dass die Leistung an der korrekten Stelle vermerkt wurde und keiner weiteren Handlung bedarf.
|
||||
ExamUserMarkedSynchronised n@Int: #{n} #{pluralDE n "Prüfungsleistung" "Prüfungsleistungen"} als synchronisiert markiert
|
||||
|
||||
ExternalExamUserMarkSynchronisedCsv: Prüfungsleistungen beim Export als synchronisiert markieren
|
||||
ExternalExamUserMarkedSynchronised n@Int: #{n} #{pluralDE n "Prüfungsleistung" "Prüfungsleistungen"} als synchronisiert markiert
|
||||
|
||||
ExamOfficeExamUsersHeading: Prüfungsleistungen
|
||||
|
||||
ActionsHead: Aktionen
|
||||
@ -1705,7 +1742,9 @@ ProportionNoRatio c@Text of@Text: #{c}/#{of}
|
||||
|
||||
CourseUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-teilnehmer
|
||||
ExamUserCsvName tid@TermId ssh@SchoolId csh@CourseShorthand examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-teilnehmer
|
||||
ExternalExamUserCsvName tid@TermId ssh@SchoolId coursen@CourseName examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase coursen}-#{foldedCase examn}-teilnehmer
|
||||
CourseApplicationsTableCsvName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungen
|
||||
ParticipantsCsvName tid@TermId ssh@SchoolId: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-kursteilnehmer
|
||||
|
||||
CsvColumnsExplanationsLabel: Spalten- & Zellenformat
|
||||
CsvColumnsExplanationsTip: Bedeutung und Format der in der CSV-Datei enthaltenen Spalten
|
||||
@ -1780,6 +1819,11 @@ ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identi
|
||||
ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden
|
||||
ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
|
||||
|
||||
ExternalExamUserCsvRegister: Prüfungsleistung hinterlegen
|
||||
ExternalExamUserCsvSetTime: Zeitpunkt anpassen
|
||||
ExternalExamUserCsvSetResult: Ergebnis anpassen
|
||||
ExternalExamUserCsvDeregister: Hinterlegte Prüfungsleistung löschen
|
||||
|
||||
CourseApplicationsTableCsvSetField: Bewerbungs-assoziiertes Studienfach ändern
|
||||
CourseApplicationsTableCsvSetVeto: Veto setzen/entfernen
|
||||
CourseApplicationsTableCsvSetRating: Bewertung eintragen
|
||||
@ -1837,6 +1881,11 @@ MailSchoolFunctionInviteHeading school@SchoolName renderedFunction@Text: #{rende
|
||||
SchoolFunctionInviteExplanation renderedFunction@Text: Sie wurden eingeladen, als #{renderedFunction} für ein Institut zu wirken. Sie erhalten, nachdem Sie die Einladung annehmen, erweiterte Rechte innerhalb des Instituts.
|
||||
SchoolFunctionInvitationAccepted school@SchoolName renderedFunction@Text: #{renderedFunction}-Einladung zum Dozent für „#{school}“ angenommen
|
||||
|
||||
MailSubjectExternalExamStaffInvitation coursen@CourseName examn@ExamName: Einladung zum Prüfer für „#{examn}“ in „#{coursen}“
|
||||
ExternalExamStaffInviteHeading coursen@CourseName examn@ExamName: Einladung zum Prüfer für „#{examn}“ in „#{coursen}“
|
||||
ExternalExamStaffInviteExplanation: Sie wurden eingeladen als Prüfer für eine Uni2work-externe Prüfung zu wirken. Sie können dann u.A. Noten für die Prüfung hinterlegen.
|
||||
ExternalExamStaffInvitationAccepted coursen@CourseName examn@ExamName: Sie sind nun als Prüfer für „#{examn}“ in „#{coursen}“ eingetragen.
|
||||
|
||||
AllocationActive: Aktiv
|
||||
AllocationName: Name
|
||||
AllocationAvailableCourses: Kurse
|
||||
@ -1935,7 +1984,7 @@ SchoolExists ssh@SchoolId: Institut „#{ssh}“ existiert bereits
|
||||
SchoolAdmin: Admin
|
||||
SchoolLecturer: Dozent
|
||||
SchoolEvaluation: Kursumfragenverwaltung
|
||||
SchoolExamOffice: Prüfungsamt
|
||||
SchoolExamOffice: Prüfungsverwaltung
|
||||
|
||||
ApplicationEditTip: Während des Bewerbungszeitraums können eigene Bewerbungen beliebig angepasst und auch wieder zurückgezogen werden.
|
||||
|
||||
@ -2013,10 +2062,10 @@ MailSubjectChangeUserDisplayEmail: Diese E-Mail Adresse in Uni2work veröffentli
|
||||
MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte!
|
||||
MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail Adresse in Uni2work veröffentlichen
|
||||
|
||||
ExamOfficeOptOutsChanged: Zuständige Prüfungsämter erfolgreich angepasst
|
||||
ExamOfficeOptOutsChanged: Zuständige Prüfungsbeauftragte erfolgreich angepasst
|
||||
|
||||
BtnCloseExam: Klausur abschließen
|
||||
ExamCloseTip: Wenn eine Klausur abgeschlossen wird, werden Prüfungsämter, die im System Noten einsehen, benachrichtigt und danach bei Änderungen informiert.
|
||||
ExamCloseTip: Wenn eine Klausur abgeschlossen wird, werden Prüfungsbeauftragte, die im System Noten einsehen, benachrichtigt und danach bei Änderungen informiert.
|
||||
ExamCloseReminder: Bitte schließen Sie die Klausur frühstmöglich, sobald die Prüfungsleistungen sich voraussichtlich nicht mehr ändern werden. Z.B. direkt nach der Klausureinsicht.
|
||||
ExamDidClose: Klausur erfolgreich abgeschlossen
|
||||
|
||||
@ -2217,3 +2266,27 @@ Deficit: Defizit
|
||||
MetricNoSamples: Keine Messwerte
|
||||
MetricName: Name
|
||||
MetricValue: Wert
|
||||
|
||||
ExternalExamSemester: Semester
|
||||
ExternalExamSchool: Institut
|
||||
ExternalExamCourseName: Veranstaltung
|
||||
ExternalExamCourseNameTip: Muss nur innerhalb von Semester und Institut eindeutig sein.
|
||||
ExternalExamCourseNamePlaceholder: Analysis I, Programmierung und Modellierung, ...
|
||||
ExternalExamExamName: Prüfung
|
||||
ExternalExamExamNameTip: Muss innerhalb der Veranstaltung eindeutig sein.
|
||||
ExternalExamExamNamePlaceholder: Klausur, Nachklausur, Projektabnahme, ...
|
||||
ExternalExamDefaultTime: Voreingestellter Zeitpunkt
|
||||
ExternalExamDefaultTimePlaceholder: Zeitpunkt
|
||||
ExternalExamDefaultTimeTip: Der Zeitpunkt zu dem die Prüfung abgelegt wurde, muss pro Teilnehmer festgelegt werden. Der hier angegebene Zeitpunkt wird als Standardwert für Teilnehmer verwendet, bei denen später nicht ein abweichender Zeitpunkt angegeben wird.
|
||||
ExternalExamShowGrades: Klausur ist benotet
|
||||
ExternalExamShowGradesTip: Sollen genaue Noten angezeigt werden, oder sollen Teilnehmer und Prüfungsbeauftragte nur informiert werden, ob die Klausur bestanden wurde?
|
||||
ExternalExamExamOfficeSchools: Zusätzliche Institute
|
||||
ExternalExamExamOfficeSchoolsTip: Prüfungsbeauftragte von Instituten, die Sie hier angeben, erhalten im System (zusätzlich zum angegebenen primären Institut) volle Einsicht in sämtliche für diese Prüfung hinterlegten Leistungen, unabhängig von den Studiendaten der Teilnehmer.
|
||||
ExternalExamStaff: Assoziierte Personen
|
||||
ExternalExamStaffTip: Assoziierte Personen werden den Prüfungsbeauftragten und Teilnehmern angezeigt und dürfen Leistungen für die Prüfung hinterlegen.
|
||||
ExternalExamStaffAlreadyAdded: Person wurde bereits der Prüfung hinzugefügt
|
||||
ExternalExamUserMustBeStaff: Sie selbst müssen stets assoziierte Person sein, für die externen Prüfungen, die Sie anlegen
|
||||
ExternalExamCourseExists: Der angegebene Kurs existiert im System. Prüfungen sollten daher direkt beim Kurs (statt extern) hinterlegt werden.
|
||||
ExternalExamExists coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ existiert bereits.
|
||||
ExternalExamCreated coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich angelegt.
|
||||
ExternalExamEdited coursen@CourseName examn@ExamName: Prüfung „#{examn}“ für Kurs „#{coursen}“ erfolgreich bearbeitet.
|
||||
@ -400,7 +400,9 @@ UnauthorizedSiteAdmin: You are no system-wide administrator.
|
||||
UnauthorizedSchoolAdmin: You are no administrator for this department.
|
||||
UnauthorizedAdminEscalation: You aren't an administrator for all departments for which this user is an administrator.
|
||||
UnauthorizedExamOffice: You are not part of an exam office.
|
||||
UnauthorizedEvaluation: You are not charged with course evaluation.
|
||||
UnauthorizedExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
|
||||
UnauthorizedExternalExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
|
||||
UnauthorizedSchoolLecturer: You are no lecturer for this department.
|
||||
UnauthorizedLecturer: You are no administrator for this course.
|
||||
UnauthorizedAllocationLecturer: You are no administrator for any of the courses of this central allocation.
|
||||
@ -412,6 +414,7 @@ UnauthorizedRegistered: You are no participant in this course.
|
||||
UnauthorizedAllocationRegistered: You are no participant in this central allocation.
|
||||
UnauthorizedExamResult: You have no results in this exam.
|
||||
UnauthorizedExamOccurrenceRegistration: Registration for exam is not done including occurrence/room.
|
||||
UnauthorizedExternalExamResult: You have no results in this exam.
|
||||
UnauthorizedParticipant: The specified user is no participant of this course.
|
||||
UnauthorizedParticipantSelf: You are no participant of this course.
|
||||
UnauthorizedApplicant: The specified user is no applicant for this course.
|
||||
@ -448,6 +451,8 @@ UnauthorizedTutor: You are no tutor.
|
||||
UnauthorizedTutorialRegisterGroup: You are already registered for a tutorial with the same registration group.
|
||||
UnauthorizedLDAP: Specified user does not log in with their campus account.
|
||||
UnauthorizedPWHash: Specified user does not log in with an Uni2work-account.
|
||||
UnauthorizedExternalExamListNotEmpty: List of external exams is not empty
|
||||
UnauthorizedExternalExamLecturer: You are not an associated person for this external exam
|
||||
|
||||
UnauthorizedPasswordResetToken: This authorisation-token may no longer be used to change passwords
|
||||
|
||||
@ -711,6 +716,7 @@ LoginNecessary: Please log in first!
|
||||
|
||||
InternalLdapError: Internal error during campus login
|
||||
|
||||
CampusUserInvalidIdent: Could not determine unique identification during campus login
|
||||
CampusUserInvalidEmail: Could not determine email address during campus login
|
||||
CampusUserInvalidDisplayName: Could not determine display name during campus login
|
||||
CampusUserInvalidGivenName: Could not determine given name during campus login
|
||||
@ -862,6 +868,9 @@ MailExamOfficeExamResultsIntro courseName termDesc examn: A course administrator
|
||||
MailSubjectExamOfficeExamResultsChanged csh examn: Results for #{examn} of #{csh} were changed
|
||||
MailExamOfficeExamResultsChangedIntro courseName termDesc examn: A course administrator has changed exam results for #{examn} of the course #{courseName} (#{termDesc}).
|
||||
|
||||
MailSubjectExamOfficeExternalExamResults coursen@CourseName examn@ExamName: Results for #{examn} in #{coursen}
|
||||
MailExamOfficeExternalExamResultsIntro coursen@CourseName termDesc@Text examn@ExamName: A course administrator has changed or initially made available the results for #{examn} of the course {coursen} (#{termDesc}).
|
||||
|
||||
MailSubjectExamRegistrationActive csh examn: Registration is now allowed for #{examn} of #{csh}
|
||||
MailExamRegistrationActiveIntro courseName termDesc examn: You may now register for #{examn} of the course #{courseName} (#{termDesc}).
|
||||
|
||||
@ -1191,6 +1200,12 @@ MenuCourseNewsNew: Add course news
|
||||
MenuCourseNewsEdit: Edit course news
|
||||
MenuCourseEventNew: New course occurrence
|
||||
MenuCourseEventEdit: Edit course occurrence
|
||||
MenuExternalExamGrades: Exam results
|
||||
MenuExternalExamUsers: Participants
|
||||
MenuExternalExamEdit: Edit
|
||||
MenuExternalExamNew: New external exam
|
||||
MenuExternalExamList: External exams
|
||||
MenuParticipantsList: Lists of course participants
|
||||
|
||||
BreadcrumbSubmissionFile: File
|
||||
BreadcrumbSubmissionUserInvite: Invitation to participate in a submission
|
||||
@ -1244,6 +1259,20 @@ BreadcrumbExamCorrect: Exam corrections
|
||||
BreadcrumbApplicationFiles: Application files
|
||||
BreadcrumbCourseNewsArchive: Archive
|
||||
BreadcrumbCourseNewsFile: File
|
||||
BreadcrumbExternalExam: External exam
|
||||
BreadcrumbExternalExamList: External exams
|
||||
BreadcrumbExternalExamNew: New external exam
|
||||
BreadcrumbExternalExamShow coursen@CourseName examn@ExamName: #{coursen}, #{examn}
|
||||
BreadcrumbExternalExamEdit: Edit
|
||||
BreadcrumbExternalExamUsers: Participants
|
||||
BreadcrumbExternalExamGrades: Exam results
|
||||
BreadcrumbExternalExamStaffInvite: Invitation
|
||||
BreadcrumbParticipantsList: Lists of course participants
|
||||
BreadcrumbParticipants: Course participants
|
||||
|
||||
ExternalExamEdit coursen examn: Edit: #{coursen}, #{examn}
|
||||
ExternalExamGrades coursen examn: Exam achievements: #{coursen}, #{examn}
|
||||
ExternalExamUsers coursen examn: Exam participants: #{coursen}, #{examn}
|
||||
|
||||
TitleMetrics: Metrics
|
||||
|
||||
@ -1253,6 +1282,7 @@ AuthPredsActiveChanged: Authorisation settings saved for the current session
|
||||
AuthTagFree: Page is freely accessable
|
||||
AuthTagAdmin: User is administrator
|
||||
AuthTagExamOffice: User is part of an exam office
|
||||
AuthTagEvaluation: User is charged with course evaluation
|
||||
AuthTagToken: User is presenting an authorisation-token
|
||||
AuthTagNoEscalation: User permissions are not being expanded to other departments
|
||||
AuthTagDeprecated: Page is not deprecated
|
||||
@ -1543,6 +1573,7 @@ ExamBonusRule: Bonus points from exercises
|
||||
ExamNoBonus': No automatic exam bonus
|
||||
ExamBonusPoints': Compute from exercise achievements
|
||||
ExamBonusManual': Manual computation
|
||||
ExamGradesExplanation: This view shows the same data as the table of exam participants. Changing participant's data and achievements is only possible via the table of exam participants. Primarily, this view allows you to check and adjust which exam achievements were properly handled by the relevant exam offices.
|
||||
|
||||
ExamRegisterForOccurrence: Registration for this exam is done by registering for an occurrence/room
|
||||
|
||||
@ -1671,10 +1702,16 @@ ExamUserSyncTime: Timestamp
|
||||
ExamUserSyncSchools: Department
|
||||
ExamUserSyncLastChange: Last changed
|
||||
ExamUserMarkSynchronised: Mark exam achievements as synchronised
|
||||
ExternalExamUserMarkSynchronised: Mark exam achievements as synchronised
|
||||
ExternalExamUserMarkSynchronisedTip: Should all exam achievements, that are included in the download, be marked as synchronised? Marking exam achievemnts as synchronised serves as a notice to other exam offices and course administrators, that the exam achievement has been dealt with properly such that no further action is required.
|
||||
|
||||
ExamUserMarkSynchronisedCsv: Mark exam achievements as synchronised while exporting
|
||||
ExamUserMarkSynchronisedCsvTip: Should all exam achievements, that are included in the download, be marked as synchronised? Marking exam achievemnts as synchronised serves as a notice to other exam offices and course administrators, that the exam achievement has been dealt with properly such that no further action is required.
|
||||
ExamUserMarkedSynchronised n: Successfully marked #{n} #{pluralEN n "exam achievement" "exam achievements"} as synchronised
|
||||
|
||||
ExternalExamUserMarkSynchronisedCsv: Mark exam achievements as synchronised while exporting
|
||||
ExternalExamUserMarkedSynchronised n: Successfully marked #{n} #{pluralEN n "exam achievement" "exam achievements"} as synchronised
|
||||
|
||||
ExamOfficeExamUsersHeading: Exam achievements
|
||||
|
||||
ActionsHead: Actions
|
||||
@ -1702,7 +1739,9 @@ ProportionNoRatio c of: #{c}/#{of}
|
||||
|
||||
CourseUserCsvName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-participants
|
||||
ExamUserCsvName tid ssh csh examn: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase examn}-participants
|
||||
ExternalExamUserCsvName tid@TermId ssh@SchoolId coursen@CourseName examn@ExamName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase coursen}-#{foldedCase examn}-participants
|
||||
CourseApplicationsTableCsvName tid ssh csh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-applications
|
||||
ParticipantsCsvName tid ssh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-participants
|
||||
|
||||
CsvColumnsExplanationsLabel: Column & cell format
|
||||
CsvColumnsExplanationsTip: Meaning and format of the columns contained in imported and exported CSV files
|
||||
@ -1777,6 +1816,11 @@ ExamUserCsvExceptionNoMatchingUser: Course participant could not be identified u
|
||||
ExamUserCsvExceptionNoMatchingStudyFeatures: The specified field did not match with any of the participant's fields of study
|
||||
ExamUserCsvExceptionNoMatchingOccurrence: Occurrence/room could not be identified uniquely
|
||||
|
||||
ExternalExamUserCsvRegister: Store exam achievement
|
||||
ExternalExamUserCsvSetTime: Adjust exam time
|
||||
ExternalExamUserCsvSetResult: Adjust exam result
|
||||
ExternalExamUserCsvDeregister: Delete stored exam achievement
|
||||
|
||||
CourseApplicationsTableCsvSetField: Modify field of study associated with the applicatio
|
||||
CourseApplicationsTableCsvSetVeto: Set/remove veto
|
||||
CourseApplicationsTableCsvSetRating: Set grading
|
||||
@ -1834,6 +1878,11 @@ MailSchoolFunctionInviteHeading school renderedFunction: Invitation to be #{rend
|
||||
SchoolFunctionInviteExplanation renderedFunction: You were invited to act as #{renderedFunction} for a department. By accepting the invitation you are granted elevated rights within the department.
|
||||
SchoolFunctionInvitationAccepted school renderedFunction: Successfully accepted invitation to be #{renderedFunction} for “#{school}”
|
||||
|
||||
MailSubjectExternalExamStaffInvitation coursen examn: Invitation to act as examiner for “#{examn}” of “#{coursen}”
|
||||
ExternalExamStaffInviteHeading coursen examn: Invitation to act as examiner for “#{examn}” of “#{coursen}”
|
||||
ExternalExamStaffInviteExplanation: You have been invited to act as an examiner for a uni2work-external exam. After accepting you will be able to upload exam results.
|
||||
ExternalExamStaffInvitationAccepted coursen examn: You are now registered as an examiner for “#{examn}” of “#{coursen}”.
|
||||
|
||||
AllocationActive: Active
|
||||
AllocationName: Name
|
||||
AllocationAvailableCourses: Courses
|
||||
@ -2215,3 +2264,27 @@ Deficit: Deficit
|
||||
MetricNoSamples: No samples
|
||||
MetricName: Name
|
||||
MetricValue: Value
|
||||
|
||||
ExternalExamSemester: Semester
|
||||
ExternalExamSchool: Department
|
||||
ExternalExamCourseName: Course
|
||||
ExternalExamCourseNameTip: Needs only be unique among within semester and department.
|
||||
ExternalExamCourseNamePlaceholder: Analysis I, Programming and Modelling, ...
|
||||
ExternalExamExamName: Exam title
|
||||
ExternalExamExamNameTip: Needs only be unique within the course.
|
||||
ExternalExamExamNamePlaceholder: Exam, Exam resit, Project discussion, ...
|
||||
ExternalExamDefaultTime: Default time
|
||||
ExternalExamDefaultTimePlaceholder: Time
|
||||
ExternalExamDefaultTimeTip: The time of the exam needs to be specified for each participant. The time entered here is used as a default value for participants for whom no different time is later specified.
|
||||
ExternalExamShowGrades: Exam is graded
|
||||
ExternalExamShowGradesTip: Should participants and relevant exam offices be show exact grades or only whether the exam was passed or failed?
|
||||
ExternalExamExamOfficeSchools: Additional departments
|
||||
ExternalExamExamOfficeSchoolsTip: Exam offices of departments you specify here will also have full access to all results for this exam disregarding the individual participants' features of study.
|
||||
ExternalExamStaff: Associated persons
|
||||
ExternalExamStaffTip: The list of ssociated persons is shown to exam offices and participants. Additionally associated persons may upload results for the exam.
|
||||
ExternalExamStaffAlreadyAdded: Person is already associated with the exam.
|
||||
ExternalExamUserMustBeStaff: You yourself must always be an associated person for exams you create.
|
||||
ExternalExamCourseExists: This course already exists with uni2work. Exams for courses that exist within uni2work should be associated with the course directly instead of being created as an external exam.
|
||||
ExternalExamExists coursen@CourseName examn@ExamName: Exam “#{examn}” already exists for course “#{coursen}”.
|
||||
ExternalExamCreated coursen@CourseName examn@ExamName: Succesfully created exam “#{examn}” for course “#{coursen}”.
|
||||
ExternalExamEdited coursen@CourseName examn@ExamName: Succesfully edited exam “#{examn}” for course “#{coursen}”.
|
||||
|
||||
52
missing-translations.sh
Executable file
52
missing-translations.sh
Executable file
@ -0,0 +1,52 @@
|
||||
#!/usr/bin/env zsh
|
||||
|
||||
set -e
|
||||
|
||||
function translations() {
|
||||
msgFile=$1
|
||||
|
||||
sed -r 's/^([^ :]+).*$/\1/' ${msgFile} \
|
||||
| sort
|
||||
}
|
||||
|
||||
typeset -a msgFiles
|
||||
msgFiles=(messages/**/*.msg)
|
||||
|
||||
typeset -a msgDirectories
|
||||
msgDirectories=()
|
||||
for msgFile (${msgFiles}); do
|
||||
if ! [[ ${msgDirectories[(ie)${msgFile:h}]} -le ${#msgDirectories} ]]; then
|
||||
msgDirectories+=(${msgFile:h})
|
||||
fi
|
||||
done
|
||||
|
||||
for msgDirectory (${msgDirectories}); do
|
||||
typeset -a dirMsgFiles
|
||||
dirMsgFiles=()
|
||||
for msgFile (${msgFiles}); do
|
||||
if [[ ${msgFile:h} == ${msgDirectory} ]]; then
|
||||
dirMsgFiles+=(${msgFile})
|
||||
fi
|
||||
done
|
||||
|
||||
(
|
||||
diffDir=""
|
||||
function cleanup() {
|
||||
cd
|
||||
[[ -n ${diffDir} ]] && rm -rf ${diffDir}
|
||||
}
|
||||
trap cleanup EXIT
|
||||
diffDir=$(mktemp -d)
|
||||
|
||||
typeset -a diffArgs
|
||||
diffArgs=()
|
||||
|
||||
for msgFile (${dirMsgFiles}); do
|
||||
translations ${msgFile} > ${diffDir}/${msgFile:t}
|
||||
diffArgs+=(${diffDir}/${msgFile:t})
|
||||
done
|
||||
|
||||
printf ">>> %s\n" ${msgDirectory}
|
||||
diff --suppress-common-lines -wB ${diffArgs}
|
||||
)
|
||||
done
|
||||
@ -11,4 +11,9 @@ ExamOfficeResultSynced
|
||||
school SchoolId Maybe
|
||||
office UserId
|
||||
result ExamResultId
|
||||
time UTCTime
|
||||
ExamOfficeExternalResultSynced
|
||||
school SchoolId Maybe
|
||||
office UserId
|
||||
result ExternalExamResultId
|
||||
time UTCTime
|
||||
23
models/external-exams.model
Normal file
23
models/external-exams.model
Normal file
@ -0,0 +1,23 @@
|
||||
ExternalExam
|
||||
term TermId
|
||||
school SchoolId
|
||||
courseName (CI Text)
|
||||
examName (CI Text)
|
||||
defaultTime UTCTime Maybe
|
||||
showGrades Bool
|
||||
UniqueExternalExam term school courseName examName
|
||||
ExternalExamResult
|
||||
user UserId
|
||||
exam ExternalExamId
|
||||
result ExamResultGrade
|
||||
time UTCTime
|
||||
lastChanged UTCTime
|
||||
UniqueExternalExamResult exam user
|
||||
ExternalExamStaff
|
||||
user UserId
|
||||
exam ExternalExamId
|
||||
UniqueExternalExamStaff exam user
|
||||
ExternalExamOfficeSchool
|
||||
school SchoolId
|
||||
exam ExternalExamId
|
||||
UniqueExternalExamOfficeSchool exam school
|
||||
239
package-lock.json
generated
239
package-lock.json
generated
@ -1,6 +1,6 @@
|
||||
{
|
||||
"name": "uni2work",
|
||||
"version": "10.3.0",
|
||||
"version": "10.4.1",
|
||||
"lockfileVersion": 1,
|
||||
"requires": true,
|
||||
"dependencies": {
|
||||
@ -4752,6 +4752,18 @@
|
||||
"yargs": "12.0.1"
|
||||
},
|
||||
"dependencies": {
|
||||
"ajv": {
|
||||
"version": "5.5.2",
|
||||
"resolved": "https://registry.npmjs.org/ajv/-/ajv-5.5.2.tgz",
|
||||
"integrity": "sha1-c7Xuyj+rZT49P5Qis0GtQiBdyWU=",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"co": "^4.6.0",
|
||||
"fast-deep-equal": "^1.0.0",
|
||||
"fast-json-stable-stringify": "^2.0.0",
|
||||
"json-schema-traverse": "^0.3.0"
|
||||
}
|
||||
},
|
||||
"date-format": {
|
||||
"version": "1.2.0",
|
||||
"resolved": "https://registry.npmjs.org/date-format/-/date-format-1.2.0.tgz",
|
||||
@ -4767,6 +4779,28 @@
|
||||
"ms": "^2.1.1"
|
||||
}
|
||||
},
|
||||
"fast-deep-equal": {
|
||||
"version": "1.1.0",
|
||||
"resolved": "https://registry.npmjs.org/fast-deep-equal/-/fast-deep-equal-1.1.0.tgz",
|
||||
"integrity": "sha1-wFNHeBfIa1HaqFPIHgWbcz0CNhQ=",
|
||||
"dev": true
|
||||
},
|
||||
"har-validator": {
|
||||
"version": "5.0.3",
|
||||
"resolved": "https://registry.npmjs.org/har-validator/-/har-validator-5.0.3.tgz",
|
||||
"integrity": "sha1-ukAsJmGU8VlW7xXg/PJCmT9qff0=",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"ajv": "^5.1.0",
|
||||
"har-schema": "^2.0.0"
|
||||
}
|
||||
},
|
||||
"json-schema-traverse": {
|
||||
"version": "0.3.1",
|
||||
"resolved": "https://registry.npmjs.org/json-schema-traverse/-/json-schema-traverse-0.3.1.tgz",
|
||||
"integrity": "sha1-NJptRMU6Ud6JtAgFxdXlm0F9M0A=",
|
||||
"dev": true
|
||||
},
|
||||
"log4js": {
|
||||
"version": "3.0.3",
|
||||
"resolved": "https://registry.npmjs.org/log4js/-/log4js-3.0.3.tgz",
|
||||
@ -4785,6 +4819,52 @@
|
||||
"integrity": "sha512-sGkPx+VjMtmA6MX27oA4FBFELFCZZ4S4XqeGOXCv68tT+jb3vk/RyaKWP0PTKyWtmLSM0b+adUTEvbs1PEaH2w==",
|
||||
"dev": true
|
||||
},
|
||||
"oauth-sign": {
|
||||
"version": "0.8.2",
|
||||
"resolved": "https://registry.npmjs.org/oauth-sign/-/oauth-sign-0.8.2.tgz",
|
||||
"integrity": "sha1-Rqarfwrq2N6unsBWV4C31O/rnUM=",
|
||||
"dev": true
|
||||
},
|
||||
"punycode": {
|
||||
"version": "1.4.1",
|
||||
"resolved": "https://registry.npmjs.org/punycode/-/punycode-1.4.1.tgz",
|
||||
"integrity": "sha1-wNWmOycYgArY4esPpSachN1BhF4=",
|
||||
"dev": true
|
||||
},
|
||||
"qs": {
|
||||
"version": "6.5.2",
|
||||
"resolved": "https://registry.npmjs.org/qs/-/qs-6.5.2.tgz",
|
||||
"integrity": "sha512-N5ZAX4/LxJmF+7wN74pUD6qAh9/wnvdQcjq9TZjevvXzSUo7bfmw91saqMjzGS2xq91/odN2dW/WOl7qQHNDGA==",
|
||||
"dev": true
|
||||
},
|
||||
"request": {
|
||||
"version": "2.87.0",
|
||||
"resolved": "https://registry.npmjs.org/request/-/request-2.87.0.tgz",
|
||||
"integrity": "sha512-fcogkm7Az5bsS6Sl0sibkbhcKsnyon/jV1kF3ajGmF0c8HrttdKTPRT9hieOaQHA5HEq6r8OyWOo/o781C1tNw==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"aws-sign2": "~0.7.0",
|
||||
"aws4": "^1.6.0",
|
||||
"caseless": "~0.12.0",
|
||||
"combined-stream": "~1.0.5",
|
||||
"extend": "~3.0.1",
|
||||
"forever-agent": "~0.6.1",
|
||||
"form-data": "~2.3.1",
|
||||
"har-validator": "~5.0.3",
|
||||
"http-signature": "~1.2.0",
|
||||
"is-typedarray": "~1.0.0",
|
||||
"isstream": "~0.1.2",
|
||||
"json-stringify-safe": "~5.0.1",
|
||||
"mime-types": "~2.1.17",
|
||||
"oauth-sign": "~0.8.2",
|
||||
"performance-now": "^2.1.0",
|
||||
"qs": "~6.5.1",
|
||||
"safe-buffer": "^5.1.1",
|
||||
"tough-cookie": "~2.3.3",
|
||||
"tunnel-agent": "^0.6.0",
|
||||
"uuid": "^3.1.0"
|
||||
}
|
||||
},
|
||||
"streamroller": {
|
||||
"version": "0.7.0",
|
||||
"resolved": "https://registry.npmjs.org/streamroller/-/streamroller-0.7.0.tgz",
|
||||
@ -4797,6 +4877,15 @@
|
||||
"readable-stream": "^2.3.0"
|
||||
}
|
||||
},
|
||||
"tough-cookie": {
|
||||
"version": "2.3.4",
|
||||
"resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.3.4.tgz",
|
||||
"integrity": "sha512-TZ6TTfI5NtZnuyy/Kecv+CnoROnyXn2DN97LontgQpCwsX2XyLYCC0ENhYkehSOwAp8rTQKc/NUIF7BkQ5rKLA==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"punycode": "^1.4.1"
|
||||
}
|
||||
},
|
||||
"ws": {
|
||||
"version": "6.0.0",
|
||||
"resolved": "https://registry.npmjs.org/ws/-/ws-6.0.0.tgz",
|
||||
@ -8626,14 +8715,22 @@
|
||||
}
|
||||
},
|
||||
"fs-extra": {
|
||||
"version": "7.0.1",
|
||||
"resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-7.0.1.tgz",
|
||||
"integrity": "sha512-YJDaCJZEnBmcbw13fvdAM9AwNOJwOzrE4pqMqBq5nFiEqXUqHwlK4B+3pUw6JNvfSPtX05xFHtYy/1ni01eGCw==",
|
||||
"version": "8.1.0",
|
||||
"resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-8.1.0.tgz",
|
||||
"integrity": "sha512-yhlQgA6mnOJUKOsRUFsgJdQCvkKhcz8tlZG5HBQfReYZy46OwLcY+Zia0mtdHsOo9y/hP+CxMN0TU9QxoOtG4g==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"graceful-fs": "^4.1.2",
|
||||
"graceful-fs": "^4.2.0",
|
||||
"jsonfile": "^4.0.0",
|
||||
"universalify": "^0.1.0"
|
||||
},
|
||||
"dependencies": {
|
||||
"graceful-fs": {
|
||||
"version": "4.2.3",
|
||||
"resolved": "https://registry.npmjs.org/graceful-fs/-/graceful-fs-4.2.3.tgz",
|
||||
"integrity": "sha512-a30VEBm4PEdx1dRB7MFK7BejejvCvBronbLjht+sHuGYj8PHs7M/5Z+rt5lw551vZ7yfTCj4Vuyy3mSJytDWRQ==",
|
||||
"dev": true
|
||||
}
|
||||
}
|
||||
},
|
||||
"fs-minipass": {
|
||||
@ -9836,39 +9933,13 @@
|
||||
"dev": true
|
||||
},
|
||||
"har-validator": {
|
||||
"version": "5.0.3",
|
||||
"resolved": "https://registry.npmjs.org/har-validator/-/har-validator-5.0.3.tgz",
|
||||
"integrity": "sha1-ukAsJmGU8VlW7xXg/PJCmT9qff0=",
|
||||
"version": "5.1.3",
|
||||
"resolved": "https://registry.npmjs.org/har-validator/-/har-validator-5.1.3.tgz",
|
||||
"integrity": "sha512-sNvOCzEQNr/qrvJgc3UG/kD4QtlHycrzwS+6mfTrrSq97BvaYcPZZI1ZSqGSPR73Cxn4LKTD4PttRwfU7jWq5g==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"ajv": "^5.1.0",
|
||||
"ajv": "^6.5.5",
|
||||
"har-schema": "^2.0.0"
|
||||
},
|
||||
"dependencies": {
|
||||
"ajv": {
|
||||
"version": "5.5.2",
|
||||
"resolved": "https://registry.npmjs.org/ajv/-/ajv-5.5.2.tgz",
|
||||
"integrity": "sha1-c7Xuyj+rZT49P5Qis0GtQiBdyWU=",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"co": "^4.6.0",
|
||||
"fast-deep-equal": "^1.0.0",
|
||||
"fast-json-stable-stringify": "^2.0.0",
|
||||
"json-schema-traverse": "^0.3.0"
|
||||
}
|
||||
},
|
||||
"fast-deep-equal": {
|
||||
"version": "1.1.0",
|
||||
"resolved": "https://registry.npmjs.org/fast-deep-equal/-/fast-deep-equal-1.1.0.tgz",
|
||||
"integrity": "sha1-wFNHeBfIa1HaqFPIHgWbcz0CNhQ=",
|
||||
"dev": true
|
||||
},
|
||||
"json-schema-traverse": {
|
||||
"version": "0.3.1",
|
||||
"resolved": "https://registry.npmjs.org/json-schema-traverse/-/json-schema-traverse-0.3.1.tgz",
|
||||
"integrity": "sha1-NJptRMU6Ud6JtAgFxdXlm0F9M0A=",
|
||||
"dev": true
|
||||
}
|
||||
}
|
||||
},
|
||||
"has": {
|
||||
@ -15639,9 +15710,9 @@
|
||||
"dev": true
|
||||
},
|
||||
"oauth-sign": {
|
||||
"version": "0.8.2",
|
||||
"resolved": "https://registry.npmjs.org/oauth-sign/-/oauth-sign-0.8.2.tgz",
|
||||
"integrity": "sha1-Rqarfwrq2N6unsBWV4C31O/rnUM=",
|
||||
"version": "0.9.0",
|
||||
"resolved": "https://registry.npmjs.org/oauth-sign/-/oauth-sign-0.9.0.tgz",
|
||||
"integrity": "sha512-fexhUFFPTGV8ybAtSIGbV6gOkSv8UtRbDBnAyLQw4QPKkgNlsH2ByPGtMUqdWkos6YCRmAqViwgZrJc/mRDzZQ==",
|
||||
"dev": true
|
||||
},
|
||||
"object-assign": {
|
||||
@ -17332,6 +17403,12 @@
|
||||
"integrity": "sha1-8FKijacOYYkX7wqKw0wa5aaChrM=",
|
||||
"dev": true
|
||||
},
|
||||
"psl": {
|
||||
"version": "1.7.0",
|
||||
"resolved": "https://registry.npmjs.org/psl/-/psl-1.7.0.tgz",
|
||||
"integrity": "sha512-5NsSEDv8zY70ScRnOTn7bK7eanl2MvFrOrS/R6x+dBt5g1ghnj9Zv90kO8GwT8gxcu2ANyFprnFYB85IogIJOQ==",
|
||||
"dev": true
|
||||
},
|
||||
"public-encrypt": {
|
||||
"version": "4.0.3",
|
||||
"resolved": "https://registry.npmjs.org/public-encrypt/-/public-encrypt-4.0.3.tgz",
|
||||
@ -17802,31 +17879,31 @@
|
||||
}
|
||||
},
|
||||
"request": {
|
||||
"version": "2.87.0",
|
||||
"resolved": "https://registry.npmjs.org/request/-/request-2.87.0.tgz",
|
||||
"integrity": "sha512-fcogkm7Az5bsS6Sl0sibkbhcKsnyon/jV1kF3ajGmF0c8HrttdKTPRT9hieOaQHA5HEq6r8OyWOo/o781C1tNw==",
|
||||
"version": "2.88.0",
|
||||
"resolved": "https://registry.npmjs.org/request/-/request-2.88.0.tgz",
|
||||
"integrity": "sha512-NAqBSrijGLZdM0WZNsInLJpkJokL72XYjUpnB0iwsRgxh7dB6COrHnTBNwN0E+lHDAJzu7kLAkDeY08z2/A0hg==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"aws-sign2": "~0.7.0",
|
||||
"aws4": "^1.6.0",
|
||||
"aws4": "^1.8.0",
|
||||
"caseless": "~0.12.0",
|
||||
"combined-stream": "~1.0.5",
|
||||
"extend": "~3.0.1",
|
||||
"combined-stream": "~1.0.6",
|
||||
"extend": "~3.0.2",
|
||||
"forever-agent": "~0.6.1",
|
||||
"form-data": "~2.3.1",
|
||||
"har-validator": "~5.0.3",
|
||||
"form-data": "~2.3.2",
|
||||
"har-validator": "~5.1.0",
|
||||
"http-signature": "~1.2.0",
|
||||
"is-typedarray": "~1.0.0",
|
||||
"isstream": "~0.1.2",
|
||||
"json-stringify-safe": "~5.0.1",
|
||||
"mime-types": "~2.1.17",
|
||||
"oauth-sign": "~0.8.2",
|
||||
"mime-types": "~2.1.19",
|
||||
"oauth-sign": "~0.9.0",
|
||||
"performance-now": "^2.1.0",
|
||||
"qs": "~6.5.1",
|
||||
"safe-buffer": "^5.1.1",
|
||||
"tough-cookie": "~2.3.3",
|
||||
"qs": "~6.5.2",
|
||||
"safe-buffer": "^5.1.2",
|
||||
"tough-cookie": "~2.4.3",
|
||||
"tunnel-agent": "^0.6.0",
|
||||
"uuid": "^3.1.0"
|
||||
"uuid": "^3.3.2"
|
||||
},
|
||||
"dependencies": {
|
||||
"qs": {
|
||||
@ -17837,6 +17914,27 @@
|
||||
}
|
||||
}
|
||||
},
|
||||
"request-promise": {
|
||||
"version": "4.2.5",
|
||||
"resolved": "https://registry.npmjs.org/request-promise/-/request-promise-4.2.5.tgz",
|
||||
"integrity": "sha512-ZgnepCykFdmpq86fKGwqntyTiUrHycALuGggpyCZwMvGaZWgxW6yagT0FHkgo5LzYvOaCNvxYwWYIjevSH1EDg==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"bluebird": "^3.5.0",
|
||||
"request-promise-core": "1.1.3",
|
||||
"stealthy-require": "^1.1.1",
|
||||
"tough-cookie": "^2.3.3"
|
||||
}
|
||||
},
|
||||
"request-promise-core": {
|
||||
"version": "1.1.3",
|
||||
"resolved": "https://registry.npmjs.org/request-promise-core/-/request-promise-core-1.1.3.tgz",
|
||||
"integrity": "sha512-QIs2+ArIGQVp5ZYbWD5ZLCY29D5CfWizP8eWnm8FoGD1TX61veauETVQbrV60662V0oFBkrDOuaBI8XgtuyYAQ==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"lodash": "^4.17.15"
|
||||
}
|
||||
},
|
||||
"require-directory": {
|
||||
"version": "2.1.1",
|
||||
"resolved": "https://registry.npmjs.org/require-directory/-/require-directory-2.1.1.tgz",
|
||||
@ -19098,6 +19196,12 @@
|
||||
"integrity": "sha1-Fhx9rBd2Wf2YEfQ3cfqZOBR4Yow=",
|
||||
"dev": true
|
||||
},
|
||||
"stealthy-require": {
|
||||
"version": "1.1.1",
|
||||
"resolved": "https://registry.npmjs.org/stealthy-require/-/stealthy-require-1.1.1.tgz",
|
||||
"integrity": "sha1-NbCYdbT/SfJqd35QmzCQoyJr8ks=",
|
||||
"dev": true
|
||||
},
|
||||
"stream-browserify": {
|
||||
"version": "2.0.2",
|
||||
"resolved": "https://registry.npmjs.org/stream-browserify/-/stream-browserify-2.0.2.tgz",
|
||||
@ -19159,6 +19263,17 @@
|
||||
"ms": "^2.1.1"
|
||||
}
|
||||
},
|
||||
"fs-extra": {
|
||||
"version": "7.0.1",
|
||||
"resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-7.0.1.tgz",
|
||||
"integrity": "sha512-YJDaCJZEnBmcbw13fvdAM9AwNOJwOzrE4pqMqBq5nFiEqXUqHwlK4B+3pUw6JNvfSPtX05xFHtYy/1ni01eGCw==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"graceful-fs": "^4.1.2",
|
||||
"jsonfile": "^4.0.0",
|
||||
"universalify": "^0.1.0"
|
||||
}
|
||||
},
|
||||
"ms": {
|
||||
"version": "2.1.2",
|
||||
"resolved": "https://registry.npmjs.org/ms/-/ms-2.1.2.tgz",
|
||||
@ -19752,11 +19867,12 @@
|
||||
"dev": true
|
||||
},
|
||||
"tough-cookie": {
|
||||
"version": "2.3.4",
|
||||
"resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.3.4.tgz",
|
||||
"integrity": "sha512-TZ6TTfI5NtZnuyy/Kecv+CnoROnyXn2DN97LontgQpCwsX2XyLYCC0ENhYkehSOwAp8rTQKc/NUIF7BkQ5rKLA==",
|
||||
"version": "2.4.3",
|
||||
"resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.4.3.tgz",
|
||||
"integrity": "sha512-Q5srk/4vDM54WJsJio3XNn6K2sCG+CQ8G5Wz6bZhRZoAe/+TxjWB/GlFAnYEbkYVlON9FMk/fE3h2RLpPXo4lQ==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"psl": "^1.1.24",
|
||||
"punycode": "^1.4.1"
|
||||
},
|
||||
"dependencies": {
|
||||
@ -20550,6 +20666,19 @@
|
||||
"lodash": ">=3.5 <5",
|
||||
"object.entries": "^1.1.0",
|
||||
"tapable": "^1.0.0"
|
||||
},
|
||||
"dependencies": {
|
||||
"fs-extra": {
|
||||
"version": "7.0.1",
|
||||
"resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-7.0.1.tgz",
|
||||
"integrity": "sha512-YJDaCJZEnBmcbw13fvdAM9AwNOJwOzrE4pqMqBq5nFiEqXUqHwlK4B+3pUw6JNvfSPtX05xFHtYy/1ni01eGCw==",
|
||||
"dev": true,
|
||||
"requires": {
|
||||
"graceful-fs": "^4.1.2",
|
||||
"jsonfile": "^4.0.0",
|
||||
"universalify": "^0.1.0"
|
||||
}
|
||||
}
|
||||
}
|
||||
},
|
||||
"webpack-plugin-hash-output": {
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{
|
||||
"name": "uni2work",
|
||||
"version": "10.3.0",
|
||||
"version": "10.4.1",
|
||||
"description": "",
|
||||
"keywords": [],
|
||||
"author": "",
|
||||
@ -74,6 +74,7 @@
|
||||
"css-loader": "^2.1.1",
|
||||
"eslint": "^5.16.0",
|
||||
"file-loader": "^5.0.2",
|
||||
"fs-extra": "^8.1.0",
|
||||
"glob": "^7.1.6",
|
||||
"html-webpack-plugin": "^3.2.0",
|
||||
"husky": "^2.7.0",
|
||||
@ -96,6 +97,8 @@
|
||||
"postcss-preset-env": "^6.7.0",
|
||||
"real-favicon-webpack-plugin": "^0.2.3",
|
||||
"remove-files-webpack-plugin": "^1.1.3",
|
||||
"request": "^2.88.0",
|
||||
"request-promise": "^4.2.5",
|
||||
"resolve-url-loader": "^3.1.1",
|
||||
"sass": "^1.23.7",
|
||||
"sass-loader": "^7.3.1",
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: uniworx
|
||||
version: 10.3.0
|
||||
version: 10.4.1
|
||||
|
||||
dependencies:
|
||||
- base
|
||||
|
||||
13
routes
13
routes
@ -80,6 +80,16 @@
|
||||
/users EOUsersR GET POST
|
||||
/users/invite EOUsersInviteR GET POST
|
||||
|
||||
/external-exam EExamListR GET !lecturer !¬empty
|
||||
/external-exam/new EExamNewR GET POST !lecturer
|
||||
/external-exam/#TermId/#SchoolId/#CourseName/#ExamName EExamR !lecturer:
|
||||
/ EEShowR GET !exam-office !exam-result
|
||||
/edit EEEditR GET POST
|
||||
/users EEUsersR GET POST
|
||||
/grades EEGradesR GET POST !exam-office
|
||||
/staff-invite EEStaffInviteR GET POST
|
||||
|
||||
|
||||
/term TermShowR GET !free
|
||||
/term/current TermCurrentR GET !free
|
||||
/term/edit TermEditR GET POST
|
||||
@ -98,6 +108,9 @@
|
||||
/register ARegisterR POST !time
|
||||
/course/#CryptoUUIDCourse/apply AApplyR POST !timeANDallocation-registered
|
||||
|
||||
/participants ParticipantsListR GET !evaluation
|
||||
/participants/#TermId/#SchoolId ParticipantsR GET !evaluation
|
||||
|
||||
|
||||
-- For Pattern Synonyms see Foundation
|
||||
/course/ CourseListR GET !free
|
||||
|
||||
@ -19,7 +19,7 @@ let
|
||||
'';
|
||||
|
||||
override = oldAttrs: {
|
||||
nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ nodejs-12_x postgresql openldap google-chrome exiftool ]) ++ (with haskellPackages; [ stack yesod-bin hlint cabal-install weeder ]);
|
||||
nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ nodejs-13_x postgresql openldap google-chrome exiftool ]) ++ (with haskellPackages; [ stack yesod-bin hlint cabal-install weeder ]);
|
||||
shellHook = ''
|
||||
export PROMPT_INFO="${oldAttrs.name}"
|
||||
|
||||
|
||||
@ -122,6 +122,8 @@ import Handler.Exam
|
||||
import Handler.Allocation
|
||||
import Handler.ExamOffice
|
||||
import Handler.Metrics
|
||||
import Handler.ExternalExam
|
||||
import Handler.Participants
|
||||
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
|
||||
@ -139,6 +139,45 @@ data Transaction
|
||||
{ transactionTutorial :: TutorialId
|
||||
}
|
||||
|
||||
| TransactionExternalExamEdit
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
}
|
||||
|
||||
| TransactionExternalExamOfficeSchoolEdit
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionSchool :: SchoolId
|
||||
}
|
||||
| TransactionExternalExamOfficeSchoolDelete
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionSchool :: SchoolId
|
||||
}
|
||||
|
||||
| TransactionExternalExamStaffEdit
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionUser :: UserId
|
||||
}
|
||||
| TransactionExternalExamStaffDelete
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionUser :: UserId
|
||||
}
|
||||
| TransactionExternalExamStaffInviteEdit
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionEmail :: UserEmail
|
||||
}
|
||||
| TransactionExternalExamStaffInviteDelete
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionEmail :: UserEmail
|
||||
}
|
||||
|
||||
| TransactionExternalExamResultEdit
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionUser :: UserId
|
||||
}
|
||||
| TransactionExternalExamResultDelete
|
||||
{ transactionExternalExam :: ExternalExamId
|
||||
, transactionUser :: UserId
|
||||
}
|
||||
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
deriveJSON defaultOptions
|
||||
|
||||
@ -3,6 +3,7 @@ module Auth.LDAP
|
||||
, campusLogin
|
||||
, CampusUserException(..)
|
||||
, campusUser, campusUser'
|
||||
, campusUserMatr, campusUserMatr'
|
||||
, CampusMessage(..)
|
||||
, ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName
|
||||
, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname
|
||||
@ -43,7 +44,7 @@ data CampusMessage = MsgCampusIdentPlaceholder
|
||||
|
||||
|
||||
findUser :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry]
|
||||
findUser LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM (not . null) . lift . flip (Ldap.search ldap ldapBase userSearchSettings) retAttrs) userFilters
|
||||
findUser conf@LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM (not . null) . lift . flip (Ldap.search ldap ldapBase $ userSearchSettings conf) retAttrs) userFilters
|
||||
where
|
||||
userFilters =
|
||||
[ ldapUserPrincipalName Ldap.:= Text.encodeUtf8 ident
|
||||
@ -54,14 +55,24 @@ findUser LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM (not
|
||||
, ldapUserEmail' <- toList ldapUserEmail
|
||||
] ++
|
||||
[ ldapUserDisplayName Ldap.:= Text.encodeUtf8 ident
|
||||
, ldapUserMatriculation Ldap.:= Text.encodeUtf8 ident
|
||||
]
|
||||
userSearchSettings = mconcat
|
||||
[ Ldap.scope ldapScope
|
||||
, Ldap.size 2
|
||||
, Ldap.time ldapSearchTimeout
|
||||
, Ldap.derefAliases Ldap.DerefAlways
|
||||
|
||||
findUserMatr :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry]
|
||||
findUserMatr conf@LdapConf{..} ldap userMatr retAttrs = fromMaybe [] <$> findM (assertM (not . null) . lift . flip (Ldap.search ldap ldapBase $ userSearchSettings conf) retAttrs) userFilters
|
||||
where
|
||||
userFilters =
|
||||
[ ldapUserMatriculation Ldap.:= Text.encodeUtf8 userMatr
|
||||
]
|
||||
|
||||
userSearchSettings :: LdapConf -> Ldap.Mod Ldap.Search
|
||||
userSearchSettings LdapConf{..} = mconcat
|
||||
[ Ldap.scope ldapScope
|
||||
, Ldap.size 2
|
||||
, Ldap.time ldapSearchTimeout
|
||||
, Ldap.derefAliases Ldap.DerefAlways
|
||||
]
|
||||
|
||||
ldapUserPrincipalName, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation, ldapSex, ldapUserSubTermsSemester :: Ldap.Attr
|
||||
ldapUserPrincipalName = Ldap.Attr "userPrincipalName"
|
||||
ldapUserDisplayName = Ldap.Attr "displayName"
|
||||
@ -99,13 +110,7 @@ campusUser conf@LdapConf{..} pool Creds{..} = liftIO . (`catches` errHandlers) $
|
||||
results <- case lookup "DN" credsExtra of
|
||||
Just userDN -> do
|
||||
let userFilter = Ldap.Present ldapUserPrincipalName
|
||||
userSearchSettings = mconcat
|
||||
[ Ldap.scope Ldap.BaseObject
|
||||
, Ldap.size 2
|
||||
, Ldap.time ldapSearchTimeout
|
||||
, Ldap.derefAliases Ldap.DerefAlways
|
||||
]
|
||||
Ldap.search ldap (Ldap.Dn userDN) userSearchSettings userFilter []
|
||||
Ldap.search ldap (Ldap.Dn userDN) (userSearchSettings conf) userFilter []
|
||||
Nothing -> do
|
||||
findUser conf ldap credsIdent []
|
||||
case results of
|
||||
@ -123,6 +128,26 @@ campusUser' conf pool User{userIdent}
|
||||
= runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUser conf pool (Creds apLdap (CI.original userIdent) [])
|
||||
|
||||
|
||||
campusUserMatr :: MonadUnliftIO m => LdapConf -> LdapPool -> UserMatriculation -> m (Ldap.AttrList [])
|
||||
campusUserMatr conf@LdapConf{..} pool userMatr = liftIO . (`catches` errHandlers) $ either (throwM . CampusUserLdapError) return <=< withLdap pool $ \ldap -> do
|
||||
Ldap.bind ldap ldapDn ldapPassword
|
||||
results <- findUserMatr conf ldap userMatr []
|
||||
case results of
|
||||
[] -> throwM CampusUserNoResult
|
||||
[Ldap.SearchEntry _ attrs] -> return attrs
|
||||
_otherwise -> throwM CampusUserAmbiguous
|
||||
where
|
||||
errHandlers = [ Exc.Handler $ \LineTooLong -> throwM CampusUserLineTooLong
|
||||
, Exc.Handler $ \(HostNotResolved host) -> throwM $ CampusUserHostNotResolved host
|
||||
, Exc.Handler $ \(HostCannotConnect host excs) -> throwM $ CampusUserHostCannotConnect host excs
|
||||
]
|
||||
|
||||
campusUserMatr' :: (MonadCatch m, MonadUnliftIO m) => LdapConf -> LdapPool -> UserMatriculation -> m (Maybe (Ldap.AttrList []))
|
||||
campusUserMatr' conf pool
|
||||
= runMaybeT . catchIfMaybeT (is _CampusUserNoResult) . campusUserMatr conf pool
|
||||
|
||||
|
||||
|
||||
campusForm :: ( RenderMessage (HandlerSite m) FormMessage
|
||||
, RenderMessage (HandlerSite m) CampusMessage
|
||||
, MonadHandler m
|
||||
|
||||
@ -17,7 +17,7 @@ module Database.Esqueleto.Utils
|
||||
, selectExists
|
||||
, SqlHashable
|
||||
, sha256
|
||||
, maybe
|
||||
, maybe, unsafeCoalesce
|
||||
, SqlProject(..)
|
||||
, (->.)
|
||||
, fromSqlKey
|
||||
@ -236,6 +236,9 @@ maybe onNothing onJust val = E.case_
|
||||
]
|
||||
(E.else_ onNothing)
|
||||
|
||||
unsafeCoalesce :: E.PersistField a => [E.SqlExpr (E.Value (Maybe a))] -> E.SqlExpr (E.Value a)
|
||||
unsafeCoalesce = E.veryUnsafeCoerceSqlExprValue . E.coalesce
|
||||
|
||||
|
||||
class (PersistEntity entity, PersistField value) => SqlProject entity value entity' value' | entity value entity' -> value', entity value value' -> entity' where
|
||||
sqlProject :: E.SqlExpr entity' -> EntityField entity value -> E.SqlExpr (E.Value value')
|
||||
|
||||
@ -23,7 +23,7 @@ import Auth.Dummy
|
||||
import qualified Network.Wai as W (pathInfo)
|
||||
|
||||
import qualified Yesod.Core.Unsafe as Unsafe
|
||||
import Data.CaseInsensitive (original, mk)
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Data.ByteArray (convert)
|
||||
import Crypto.Hash (Digest, SHAKE256, SHAKE128)
|
||||
@ -45,6 +45,7 @@ import qualified Data.Set as Set
|
||||
import Data.Map (Map, (!?))
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.HashSet as HashSet
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
|
||||
import Data.List (nubBy, (!!), findIndex, inits)
|
||||
import qualified Data.List as List
|
||||
@ -69,6 +70,7 @@ import qualified Control.Monad.Catch as C
|
||||
import Handler.Utils.StudyFeatures
|
||||
import Handler.Utils.SchoolLdap
|
||||
import Handler.Utils.ExamOffice.Exam
|
||||
import Handler.Utils.ExamOffice.ExternalExam
|
||||
import Handler.Utils.ExamOffice.Course
|
||||
import Handler.Utils.Profile
|
||||
import Handler.Utils.Routes
|
||||
@ -371,10 +373,34 @@ tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of
|
||||
E.where_ $ examOfficeExamResultAuth (E.val authId) examResult
|
||||
guardMExceptT hasUsers (unauthorizedI MsgUnauthorizedExamExamOffice)
|
||||
return Authorized
|
||||
EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
hasUsers <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamResult) -> do
|
||||
E.on $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
|
||||
|
||||
E.where_ $ eexam E.^. ExternalExamTerm E.==. E.val tid
|
||||
E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
|
||||
E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
|
||||
E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
|
||||
|
||||
E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
|
||||
guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
|
||||
return Authorized
|
||||
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice] []
|
||||
guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedExamOffice)
|
||||
isExamOffice <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice]
|
||||
guardMExceptT isExamOffice (unauthorizedI MsgUnauthorizedExamOffice)
|
||||
return Authorized
|
||||
tagAccessPredicate AuthEvaluation = APDB $ \mAuthId route _ -> case route of
|
||||
ParticipantsR tid ssh -> $cachedHereBinary (mAuthId, tid, ssh) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isEvaluation <- lift . existsBy $ UniqueUserFunction authId ssh SchoolEvaluation
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
|
||||
return Authorized
|
||||
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isEvaluation <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolEvaluation]
|
||||
guardMExceptT isEvaluation $ unauthorizedI MsgUnauthorizedEvaluation
|
||||
return Authorized
|
||||
tagAccessPredicate AuthToken = APDB $ \mAuthId route isWrite -> exceptT return return $
|
||||
lift . validateToken mAuthId route isWrite =<< askTokenUnsafe
|
||||
@ -420,7 +446,18 @@ tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
|
||||
E.&&. allocation E.^. AllocationTerm E.==. E.val tid
|
||||
E.&&. allocation E.^. AllocationSchool E.==. E.val ssh
|
||||
E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
|
||||
guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedAllocationLecturer)
|
||||
guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedAllocationLecturer
|
||||
return Authorized
|
||||
EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isLecturer <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` staff) -> do
|
||||
E.on $ eexam E.^. ExternalExamId E.==. staff E.^. ExternalExamStaffExam
|
||||
E.where_ $ staff E.^. ExternalExamStaffUser E.==. E.val authId
|
||||
E.&&. eexam E.^. ExternalExamTerm E.==. E.val tid
|
||||
E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
|
||||
E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
|
||||
E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
|
||||
guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedExternalExamLecturer
|
||||
return Authorized
|
||||
-- lecturer for any school will do
|
||||
_ -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
@ -886,6 +923,17 @@ tagAccessPredicate AuthExamResult = APDB $ \mAuthId route _ -> case route of
|
||||
E.&&. exam E.^. ExamName E.==. E.val examn
|
||||
guardMExceptT (hasResult || hasPartResult) (unauthorizedI MsgUnauthorizedExamResult)
|
||||
return Authorized
|
||||
EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
hasResult <- $cachedHereBinary (authId, tid, ssh, coursen, examn) . lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamResult) -> do
|
||||
E.on $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
|
||||
E.where_ $ eexamResult E.^. ExternalExamResultUser E.==. E.val authId
|
||||
E.&&. eexam E.^. ExternalExamTerm E.==. E.val tid
|
||||
E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
|
||||
E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
|
||||
E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
|
||||
guardMExceptT hasResult $ unauthorizedI MsgUnauthorizedExternalExamResult
|
||||
return Authorized
|
||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
hasResult <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examResult) -> do
|
||||
@ -1049,7 +1097,14 @@ tagAccessPredicate AuthRegisterGroup = APDB $ \mAuthId route _ -> case route of
|
||||
guard $ not hasOther
|
||||
return Authorized
|
||||
r -> $unsupportedAuthPredicate AuthRegisterGroup r
|
||||
tagAccessPredicate AuthEmpty = APDB $ \_ route _ -> case route of
|
||||
tagAccessPredicate AuthEmpty = APDB $ \mAuthId route _ -> case route of
|
||||
EExamListR -> exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
hasExternalExams <- $cachedHereBinary authId . lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamStaff) -> do
|
||||
E.on $ eexam E.^. ExternalExamId E.==. eexamStaff E.^. ExternalExamStaffExam
|
||||
E.where_ $ eexamStaff E.^. ExternalExamStaffUser E.==. E.val authId
|
||||
guardMExceptT (not hasExternalExams) $ unauthorizedI MsgUnauthorizedExternalExamListNotEmpty
|
||||
return Authorized
|
||||
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNotEmpty) $ do
|
||||
-- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
|
||||
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||
@ -1516,8 +1571,9 @@ siteLayout' headingOverride widget = do
|
||||
where
|
||||
go crumbs Nothing = return crumbs
|
||||
go crumbs (Just cRoute) = do
|
||||
hasAccess <- hasReadAccessTo cRoute
|
||||
(title, next) <- breadcrumb cRoute
|
||||
go ((cRoute, title) : crumbs) next
|
||||
go ((cRoute, title, hasAccess) : crumbs) next
|
||||
(title, parents) <- breadcrumbs' mcurrentRoute
|
||||
|
||||
-- let isParent :: Route UniWorX -> Bool
|
||||
@ -1604,7 +1660,7 @@ siteLayout' headingOverride widget = do
|
||||
}
|
||||
|
||||
let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
|
||||
highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents
|
||||
highlight = let crumbs = mcons mcurrentRoute $ view _1 <$> reverse parents
|
||||
navItems = map (view _2) favourites ++ map (urlRoute . menuItemRoute . view _1) menuTypes
|
||||
highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map (view _2) favourites) crumbs
|
||||
in \r -> Just r == highR
|
||||
@ -1753,7 +1809,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
|
||||
breadcrumb (SchoolR ssh SchoolEditR) = maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
|
||||
School{..} <- MaybeT . runDB $ get ssh
|
||||
return (original schoolName, Just SchoolListR)
|
||||
return (CI.original schoolName, Just SchoolListR)
|
||||
breadcrumb SchoolNewR = i18nCrumb MsgMenuSchoolNew $ Just SchoolListR
|
||||
|
||||
breadcrumb (ExamOfficeR EOExamsR) = i18nCrumb MsgMenuExamOfficeExams Nothing
|
||||
@ -1793,13 +1849,13 @@ instance YesodBreadcrumbs UniWorX where
|
||||
guardM . lift . runDB $
|
||||
(&&) <$> fmap isJust (get ssh)
|
||||
<*> fmap isJust (get tid)
|
||||
return (original $ unSchoolKey ssh, Just $ TermCourseListR tid)
|
||||
return (CI.original $ unSchoolKey ssh, Just $ TermCourseListR tid)
|
||||
|
||||
breadcrumb AllocationListR = i18nCrumb MsgAllocationListTitle $ Just HomeR
|
||||
breadcrumb (AllocationR tid ssh ash AShowR) = maybeT (i18nCrumb MsgBreadcrumbAllocation $ Just AllocationListR) $ do
|
||||
mr <- getMessageRender
|
||||
Entity _ Allocation{allocationName} <- MaybeT . runDB . getBy $ TermSchoolAllocationShort tid ssh ash
|
||||
return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ AllocationListR)
|
||||
return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{CI.original (unSchoolKey ssh)})|], Just $ AllocationListR)
|
||||
breadcrumb (AllocationR tid ssh ash ARegisterR) = i18nCrumb MsgBreadcrumbAllocationRegister . Just $ AllocationR tid ssh ash AShowR
|
||||
breadcrumb (AllocationR tid ssh ash (AApplyR cID)) = maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ AllocationR tid ssh ash AShowR) $ do
|
||||
cid <- decrypt cID
|
||||
@ -1807,13 +1863,16 @@ instance YesodBreadcrumbs UniWorX where
|
||||
aid <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash
|
||||
guardM . lift $ exists [ AllocationCourseAllocation ==. aid, AllocationCourseCourse ==. cid ]
|
||||
MaybeT $ get cid
|
||||
return (original courseName, Just $ AllocationR tid ssh ash AShowR)
|
||||
return (CI.original courseName, Just $ AllocationR tid ssh ash AShowR)
|
||||
|
||||
breadcrumb ParticipantsListR = i18nCrumb MsgBreadcrumbParticipantsList $ Just CourseListR
|
||||
breadcrumb (ParticipantsR _ _) = i18nCrumb MsgBreadcrumbParticipants $ Just ParticipantsListR
|
||||
|
||||
breadcrumb CourseListR = i18nCrumb MsgMenuCourseList Nothing
|
||||
breadcrumb CourseNewR = i18nCrumb MsgMenuCourseNew $ Just CourseListR
|
||||
breadcrumb (CourseR tid ssh csh CShowR) = maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ TermSchoolCourseListR tid ssh) $ do
|
||||
guardM . lift . runDB . existsBy $ TermSchoolCourseShort tid ssh csh
|
||||
return (original csh, Just $ TermSchoolCourseListR tid ssh)
|
||||
return (CI.original csh, Just $ TermSchoolCourseListR tid ssh)
|
||||
breadcrumb (CourseR tid ssh csh CEditR) = i18nCrumb MsgMenuCourseEdit . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CUsersR) = i18nCrumb MsgMenuCourseMembers . Just $ CourseR tid ssh csh CShowR
|
||||
breadcrumb (CourseR tid ssh csh CAddUserR) = i18nCrumb MsgMenuCourseAddMembers . Just $ CourseR tid ssh csh CUsersR
|
||||
@ -1871,7 +1930,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh (ExamR examn sRoute)) = case sRoute of
|
||||
EShowR -> maybeT (i18nCrumb MsgBreadcrumbExam . Just $ CourseR tid ssh csh CExamListR) $ do
|
||||
guardM . hasReadAccessTo $ CExamR tid ssh csh examn EShowR
|
||||
return (original examn, Just $ CourseR tid ssh csh CExamListR)
|
||||
return (CI.original examn, Just $ CourseR tid ssh csh CExamListR)
|
||||
EEditR -> i18nCrumb MsgMenuExamEdit . Just $ CExamR tid ssh csh examn EShowR
|
||||
EUsersR -> i18nCrumb MsgMenuExamUsers . Just $ CExamR tid ssh csh examn EShowR
|
||||
EAddUserR -> i18nCrumb MsgMenuExamAddMembers . Just $ CExamR tid ssh csh examn EUsersR
|
||||
@ -1885,7 +1944,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
|
||||
TUsersR -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
|
||||
guardM . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
|
||||
return (original tutn, Just $ CourseR tid ssh csh CTutorialListR)
|
||||
return (CI.original tutn, Just $ CourseR tid ssh csh CTutorialListR)
|
||||
TEditR -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
TCommR -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR
|
||||
@ -1895,7 +1954,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
|
||||
SShowR -> maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do
|
||||
guardM . hasReadAccessTo $ CSheetR tid ssh csh shn SShowR
|
||||
return (original shn, Just $ CourseR tid ssh csh SheetListR)
|
||||
return (CI.original shn, Just $ CourseR tid ssh csh SheetListR)
|
||||
SEditR -> i18nCrumb MsgMenuSheetEdit . Just $ CSheetR tid ssh csh shn SShowR
|
||||
SDelR -> i18nCrumb MsgMenuSheetDelete . Just $ CSheetR tid ssh csh shn SShowR
|
||||
SSubsR -> i18nCrumb MsgMenuSubmissions . Just $ CSheetR tid ssh csh shn SShowR
|
||||
@ -1928,7 +1987,7 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (CourseR tid ssh csh (MaterialR mnm sRoute)) = case sRoute of
|
||||
MShowR -> maybeT (i18nCrumb MsgBreadcrumbMaterial . Just $ CourseR tid ssh csh MaterialListR) $ do
|
||||
guardM . hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
|
||||
return (original mnm, Just $ CourseR tid ssh csh MaterialListR)
|
||||
return (CI.original mnm, Just $ CourseR tid ssh csh MaterialListR)
|
||||
MEditR -> i18nCrumb MsgMenuMaterialEdit . Just $ CMaterialR tid ssh csh mnm MShowR
|
||||
MDelR -> i18nCrumb MsgMenuMaterialDelete . Just $ CMaterialR tid ssh csh mnm MShowR
|
||||
MArchiveR -> i18nCrumb MsgBreadcrumbMaterialArchive . Just $ CMaterialR tid ssh csh mnm MShowR
|
||||
@ -1950,6 +2009,26 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb MessageListR = i18nCrumb MsgMenuMessageList $ Just AdminR
|
||||
|
||||
breadcrumb GlossaryR = i18nCrumb MsgMenuGlossary $ Just InfoR
|
||||
|
||||
breadcrumb EExamListR = i18nCrumb MsgMenuExternalExamList Nothing
|
||||
breadcrumb EExamNewR = do
|
||||
isEO <- hasReadAccessTo $ ExamOfficeR EOExamsR
|
||||
i18nCrumb MsgBreadcrumbExternalExamNew . Just $ if
|
||||
| isEO -> ExamOfficeR EOExamsR
|
||||
| otherwise -> EExamListR
|
||||
breadcrumb (EExamR tid ssh coursen examn sRoute) = case sRoute of
|
||||
EEShowR -> do
|
||||
isEO <- hasReadAccessTo $ ExamOfficeR EOExamsR
|
||||
maybeT (i18nCrumb MsgBreadcrumbExternalExam . Just $ bool EExamListR (ExamOfficeR EOExamsR) isEO) $ do
|
||||
guardM . hasReadAccessTo $ EExamR tid ssh coursen examn EEShowR
|
||||
i18nCrumb (MsgBreadcrumbExternalExamShow coursen examn) . Just $ if
|
||||
| isEO -> ExamOfficeR EOExamsR
|
||||
| otherwise -> EExamListR
|
||||
EEEditR -> i18nCrumb MsgBreadcrumbExternalExamEdit . Just $ EExamR tid ssh coursen examn EEShowR
|
||||
EEUsersR -> i18nCrumb MsgBreadcrumbExternalExamUsers . Just $ EExamR tid ssh coursen examn EEShowR
|
||||
EEGradesR -> i18nCrumb MsgBreadcrumbExternalExamGrades . Just $ EExamR tid ssh coursen examn EEShowR
|
||||
EEStaffInviteR -> i18nCrumb MsgBreadcrumbExternalExamStaffInvite . Just $ EExamR tid ssh coursen examn EEShowR
|
||||
|
||||
-- breadcrumb _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
|
||||
|
||||
submissionList :: TermId -> CourseShorthand -> SheetName -> UserId -> DB [E.Value SubmissionId]
|
||||
@ -2136,6 +2215,14 @@ pageActions (HomeR) =
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuExternalExamList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute EExamListR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuOpenCourses
|
||||
@ -2355,6 +2442,14 @@ pageActions TermShowR =
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuParticipantsList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute ParticipantsListR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (TermCourseListR tid) =
|
||||
[ MenuItem
|
||||
@ -2411,6 +2506,14 @@ pageActions (CourseListR) =
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuParticipantsList
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute ParticipantsListR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseNewR) = [
|
||||
MenuItem
|
||||
@ -2633,8 +2736,8 @@ pageActions (CourseR tid ssh csh SheetListR) =
|
||||
, menuItemLabel = MsgMenuCorrectionsOwn
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid)
|
||||
, ("corrections-school", original $ unSchoolKey ssh)
|
||||
, ("corrections-course", original csh)
|
||||
, ("corrections-school", CI.original $ unSchoolKey ssh)
|
||||
, ("corrections-course", CI.original csh)
|
||||
])
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = do
|
||||
@ -2868,9 +2971,9 @@ pageActions (CSheetR tid ssh csh shn SShowR) =
|
||||
, menuItemLabel = MsgMenuCorrectionsOwn
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute (CorrectionsR, [ ("corrections-term" , termToText $ unTermKey tid)
|
||||
, ("corrections-school", original $ unSchoolKey ssh)
|
||||
, ("corrections-course", original csh)
|
||||
, ("corrections-sheet" , original shn)
|
||||
, ("corrections-school", CI.original $ unSchoolKey ssh)
|
||||
, ("corrections-course", CI.original csh)
|
||||
, ("corrections-sheet" , CI.original shn)
|
||||
])
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh
|
||||
@ -3080,6 +3183,72 @@ pageActions (CorrectionsGradeR) =
|
||||
return $ orOf (traverse . _Value . _submissionModeCorrector) sheets
|
||||
}
|
||||
]
|
||||
pageActions EExamListR =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuExternalExamNew
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute EExamNewR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (EExamR tid ssh coursen examn EEShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuExternalExamEdit
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEEditR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuExternalExamUsers
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEUsersR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuExternalExamGrades
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEGradesR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (EExamR tid ssh coursen examn EEGradesR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuExternalExamUsers
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEUsersR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (EExamR tid ssh coursen examn EEUsersR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgMenuExternalExamGrades
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEGradesR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions ParticipantsListR =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgCsvOptions
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute CsvOptionsR
|
||||
, menuItemModal = True
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions _ = []
|
||||
|
||||
|
||||
@ -3197,6 +3366,7 @@ routeNormalizers =
|
||||
, ncMaterial
|
||||
, ncTutorial
|
||||
, ncExam
|
||||
, ncExternalExam
|
||||
, verifySubmission
|
||||
, verifyCourseApplication
|
||||
, verifyCourseNews
|
||||
@ -3220,7 +3390,7 @@ routeNormalizers =
|
||||
|
||||
caseChanged :: (Eq a, Show a) => CI a -> CI a -> MaybeT (WriterT Any DB) ()
|
||||
caseChanged a b
|
||||
| ((/=) `on` original) a b = do
|
||||
| ((/=) `on` CI.original) a b = do
|
||||
$logDebugS "routeNormalizers" [st|#{tshow a} /= #{tshow b}|]
|
||||
tell $ Any True
|
||||
| otherwise = return ()
|
||||
@ -3265,6 +3435,14 @@ routeNormalizers =
|
||||
Entity _ Exam{..} <- MaybeT . $cachedHereBinary (cid, examn) . lift . getBy $ UniqueExam cid examn
|
||||
caseChanged examn examName
|
||||
return $ route & typesUsing @RouteChildren @ExamName . filtered (== examn) .~ examName
|
||||
ncExternalExam = maybeOrig $ \route -> do
|
||||
EExamR tid ssh coursen examn _ <- return route
|
||||
Entity _ ExternalExam{..} <- MaybeT . $cachedHereBinary (tid, ssh, coursen, examn) . lift . getBy $ UniqueExternalExam tid ssh coursen examn
|
||||
caseChanged coursen externalExamCourseName
|
||||
caseChanged examn externalExamExamName
|
||||
return $ route
|
||||
& typesUsing @RouteChildren @CourseName . filtered (== coursen) .~ externalExamCourseName
|
||||
& typesUsing @RouteChildren @ExamName . filtered (== examn) .~ externalExamExamName
|
||||
verifySubmission = maybeOrig $ \route -> do
|
||||
CSubmissionR _tid _ssh _csh _shn cID sr <- return route
|
||||
sId <- $cachedHereBinary cID $ decrypt cID
|
||||
@ -3304,7 +3482,8 @@ instance YesodPersistRunner UniWorX where
|
||||
return . (, cleanup) $ DBRunner (\act -> $logDebugS "YesodPersist" "runDBRunner" >> runDBRunner act)
|
||||
|
||||
data CampusUserConversionException
|
||||
= CampusUserInvalidEmail
|
||||
= CampusUserInvalidIdent
|
||||
| CampusUserInvalidEmail
|
||||
| CampusUserInvalidDisplayName
|
||||
| CampusUserInvalidGivenName
|
||||
| CampusUserInvalidSurname
|
||||
@ -3318,12 +3497,36 @@ instance Exception CampusUserConversionException
|
||||
|
||||
embedRenderMessage ''UniWorX ''CampusUserConversionException id
|
||||
|
||||
upsertCampusUser :: Ldap.AttrList [] -> Creds UniWorX -> DB (Entity User)
|
||||
upsertCampusUser ldapData Creds{..} = do
|
||||
data UpsertCampusUserMode
|
||||
= UpsertCampusUser
|
||||
| UpsertCampusUserDummy { upsertCampusUserIdent :: UserIdent }
|
||||
| UpsertCampusUserOther { uspertCampusUserIdent :: UserIdent }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
makeLenses_ ''UpsertCampusUserMode
|
||||
makePrisms ''UpsertCampusUserMode
|
||||
|
||||
_upsertCampusUserMode :: Traversal' (Creds UniWorX) UpsertCampusUserMode
|
||||
_upsertCampusUserMode mMode cs@Creds{..}
|
||||
| credsPlugin == "dummy" = setMode <$> mMode (UpsertCampusUserDummy $ CI.mk credsIdent)
|
||||
| credsPlugin `elem` others = setMode <$> mMode (UpsertCampusUserOther $ CI.mk credsIdent)
|
||||
| otherwise = setMode <$> mMode UpsertCampusUser
|
||||
where
|
||||
setMode UpsertCampusUser
|
||||
= cs{ credsPlugin = "LDAP" }
|
||||
setMode (UpsertCampusUserDummy ident)
|
||||
= cs{ credsPlugin = "dummy", credsIdent = CI.original ident }
|
||||
setMode (UpsertCampusUserOther ident)
|
||||
= cs{ credsPlugin = bool (NonEmpty.head others) credsPlugin (credsPlugin `elem` others), credsIdent = CI.original ident }
|
||||
|
||||
others = "PWHash" :| []
|
||||
|
||||
upsertCampusUser :: UpsertCampusUserMode -> Ldap.AttrList [] -> DB (Entity User)
|
||||
upsertCampusUser plugin ldapData = do
|
||||
now <- liftIO getCurrentTime
|
||||
UserDefaultConf{..} <- getsYesod $ view _appUserDefaults
|
||||
|
||||
let
|
||||
userIdent'' = fold [ v | (k, v) <- ldapData, k == ldapUserPrincipalName ]
|
||||
userMatrikelnummer' = fold [ v | (k, v) <- ldapData, k == ldapUserMatriculation ]
|
||||
userEmail' = fold $ do
|
||||
k' <- toList ldapUserEmail
|
||||
@ -3337,13 +3540,23 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
userSex' = fold [ v | (k, v) <- ldapData, k == ldapSex ]
|
||||
|
||||
userAuthentication
|
||||
| isPWHash = error "PWHash should only work for users that are already known"
|
||||
| is _UpsertCampusUserOther plugin
|
||||
= error "PWHash should only work for users that are already known"
|
||||
| otherwise = AuthLDAP
|
||||
userLastAuthentication = now <$ guard (not isDummy)
|
||||
userLastAuthentication = now <$ guard (isn't _UpsertCampusUserDummy plugin)
|
||||
|
||||
userIdent <- if
|
||||
| [bs] <- userIdent''
|
||||
, Right userIdent' <- CI.mk <$> Text.decodeUtf8' bs
|
||||
, hasn't _upsertCampusUserIdent plugin || has (_upsertCampusUserIdent . only userIdent') plugin
|
||||
-> return userIdent'
|
||||
| Just userIdent' <- plugin ^? _upsertCampusUserIdent
|
||||
-> return userIdent'
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidIdent
|
||||
userEmail <- if
|
||||
| userEmail : _ <- mapMaybe (assertM (elem '@') . either (const Nothing) Just . Text.decodeUtf8') userEmail'
|
||||
-> return $ mk userEmail
|
||||
-> return $ CI.mk userEmail
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidEmail
|
||||
userDisplayName' <- if
|
||||
@ -3393,8 +3606,7 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
|
||||
let
|
||||
newUser = User
|
||||
{ userIdent = mk credsIdent
|
||||
, userMaxFavourites = userDefaultMaxFavourites
|
||||
{ userMaxFavourites = userDefaultMaxFavourites
|
||||
, userMaxFavouriteTerms = userDefaultMaxFavouriteTerms
|
||||
, userTheme = userDefaultTheme
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
@ -3422,9 +3634,9 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
, UserSex =. userSex
|
||||
, UserLastLdapSynchronisation =. Just now
|
||||
] ++
|
||||
[ UserLastAuthentication =. Just now | not isDummy ]
|
||||
[ UserLastAuthentication =. Just now | isn't _UpsertCampusUserDummy plugin ]
|
||||
|
||||
user@(Entity userId userRec) <- upsertBy (UniqueAuthentication $ mk credsIdent) newUser userUpdate
|
||||
user@(Entity userId userRec) <- upsertBy (UniqueAuthentication userIdent) newUser userUpdate
|
||||
unless (validDisplayName userTitle userFirstName userSurname $ userDisplayName userRec) $
|
||||
update userId [ UserDisplayName =. userDisplayName' ]
|
||||
|
||||
@ -3437,7 +3649,7 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
Right str <- return $ Text.decodeUtf8' v'
|
||||
return str
|
||||
|
||||
termNames = nubBy ((==) `on` mk) $ do
|
||||
termNames = nubBy ((==) `on` CI.mk) $ do
|
||||
(k, v) <- ldapData
|
||||
guard $ k == ldapUserFieldName
|
||||
v' <- v
|
||||
@ -3508,7 +3720,7 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
| otherwise -> do
|
||||
$logDebugS "Campus" [st|Ignoring subterm “#{tshow subterm}”|]
|
||||
assimilateSubTerms subterms unusedFeats
|
||||
$logDebugS "Campus" [st|Terms for “#{credsIdent}”: #{tshow (sts, fs')}|]
|
||||
$logDebugS "Campus" [st|Terms for “#{userIdent}”: #{tshow (sts, fs')}|]
|
||||
(fs, studyFieldParentCandidates) <- runWriterT $ assimilateSubTerms sts fs'
|
||||
|
||||
let
|
||||
@ -3614,8 +3826,6 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
return user
|
||||
where
|
||||
insertMaybe key val = get key >>= maybe (insert_ val) (\_ -> return ())
|
||||
isDummy = credsPlugin == "dummy"
|
||||
isPWHash = credsPlugin == "PWHash"
|
||||
|
||||
associateUserSchoolsByTerms :: UserId -> DB ()
|
||||
associateUserSchoolsByTerms uid = do
|
||||
@ -3691,18 +3901,18 @@ instance YesodAuth UniWorX where
|
||||
setTitleI MsgLoginTitle
|
||||
$(widgetFile "login")
|
||||
|
||||
authenticate Creds{..} = liftHandler . runDB $ do
|
||||
authenticate creds@Creds{..} = liftHandler . runDB $ do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
let
|
||||
userIdent = mk credsIdent
|
||||
uAuth = UniqueAuthentication userIdent
|
||||
uAuth = UniqueAuthentication $ CI.mk credsIdent
|
||||
upsertMode = creds ^? _upsertCampusUserMode
|
||||
|
||||
isDummy = credsPlugin == "dummy"
|
||||
isPWHash = credsPlugin == "PWHash"
|
||||
isDummy = is (_Just . _UpsertCampusUserDummy) upsertMode
|
||||
isOther = is (_Just . _UpsertCampusUserOther) upsertMode
|
||||
|
||||
excRecovery res
|
||||
| isDummy || isPWHash
|
||||
| isDummy || isOther
|
||||
= do
|
||||
case res of
|
||||
UserError err -> addMessageI Error err
|
||||
@ -3746,12 +3956,12 @@ instance YesodAuth UniWorX where
|
||||
UniWorX{ appSettings' = AppSettings{ appUserDefaults = UserDefaultConf{..}, ..}, .. } <- getYesod
|
||||
|
||||
flip catches excHandlers $ case (,) <$> appLdapConf <*> appLdapPool of
|
||||
Just (ldapConf, ldapPool) -> do
|
||||
let userCreds = Creds credsPlugin (original userIdent) credsExtra
|
||||
ldapData <- campusUser ldapConf ldapPool userCreds
|
||||
$logDebugS "LDAP" $ "Successful LDAP lookup: " <> tshow ldapData
|
||||
Authenticated . entityKey <$> upsertCampusUser ldapData userCreds
|
||||
Nothing
|
||||
Just (ldapConf, ldapPool)
|
||||
| Just upsertMode' <- upsertMode -> do
|
||||
ldapData <- campusUser ldapConf ldapPool Creds{..}
|
||||
$logDebugS "LDAP" $ "Successful LDAP lookup: " <> tshow ldapData
|
||||
Authenticated . entityKey <$> upsertCampusUser upsertMode' ldapData
|
||||
_other
|
||||
-> acceptExisting
|
||||
|
||||
authPlugins (UniWorX{ appSettings' = AppSettings{..}, appLdapPool }) = catMaybes
|
||||
|
||||
@ -31,6 +31,7 @@ deriving instance Generic SubmissionR
|
||||
deriving instance Generic MaterialR
|
||||
deriving instance Generic TutorialR
|
||||
deriving instance Generic ExamR
|
||||
deriving instance Generic EExamR
|
||||
deriving instance Generic CourseApplicationR
|
||||
deriving instance Generic AllocationR
|
||||
deriving instance Generic SchoolR
|
||||
|
||||
@ -75,7 +75,7 @@ lecturerInvitationConfig = InvitationConfig{..}
|
||||
where
|
||||
toJunction jLecturerType = (JunctionLecturer{..}, ())
|
||||
lFs = fslI MsgLecturerType & setTooltip MsgCourseLecturerRightsIdentical
|
||||
invitationInsertHook _ _ _ _ = id
|
||||
invitationInsertHook _ _ _ _ _ = id
|
||||
invitationSuccessMsg (Entity _ Course{..}) (Entity _ Lecturer{..}) = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return . SomeMessage $ MsgLecturerInvitationAccepted (mr lecturerType) courseShorthand
|
||||
|
||||
@ -91,7 +91,7 @@ participantInvitationConfig = InvitationConfig{..}
|
||||
studyFeatures <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid)
|
||||
(fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
|
||||
return . fmap (, ()) $ JunctionParticipant <$> pure now <*> studyFeatures <*> pure Nothing
|
||||
invitationInsertHook _ _ CourseParticipant{..} _ act = do
|
||||
invitationInsertHook _ _ _ CourseParticipant{..} _ act = do
|
||||
res <- act
|
||||
audit $ TransactionCourseParticipantEdit courseParticipantCourse courseParticipantUser
|
||||
return res
|
||||
|
||||
@ -71,7 +71,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ _ _ = pure (JunctionExamCorrector, ())
|
||||
invitationInsertHook _ _ _ _ = id
|
||||
invitationInsertHook _ _ _ _ _ = id
|
||||
invitationSuccessMsg (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInvitationAccepted examName
|
||||
invitationUltDest (Entity _ Exam{..}) _ = do
|
||||
Course{..} <- get404 examCourse
|
||||
|
||||
@ -97,7 +97,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
|
||||
fieldRes <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature) Nothing
|
||||
return $ (JunctionExamRegistration invDBExamRegistrationOccurrence now, ) . Just <$> fieldRes
|
||||
(True , _ ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, Nothing)
|
||||
invitationInsertHook (Entity eid Exam{..}) _ ExamRegistration{..} mField act = do
|
||||
invitationInsertHook _ (Entity eid Exam{..}) _ ExamRegistration{..} mField act = do
|
||||
whenIsJust mField $ \cpField -> do
|
||||
insert_ $ CourseParticipant examCourse examRegistrationUser examRegistrationTime cpField Nothing
|
||||
queueDBJob . JobQueueNotification $ NotificationCourseRegistered examRegistrationUser examCourse
|
||||
|
||||
@ -8,6 +8,7 @@ import Import hiding ((<.), (.>))
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Exam
|
||||
import Handler.Utils.Users
|
||||
import Handler.Utils.Csv
|
||||
|
||||
import Handler.ExamOffice.Exam (examCloseWidget)
|
||||
@ -372,7 +373,7 @@ data ExamUserCsvAction
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 3 . dropEnd 1 . splitCamel
|
||||
, fieldLabelModifier = camelToPathPiece' 3
|
||||
, fieldLabelModifier = camelToPathPiece' 4
|
||||
, sumEncoding = TaggedObject "action" "data"
|
||||
} ''ExamUserCsvAction
|
||||
|
||||
@ -624,7 +625,7 @@ postEUsersR tid ssh csh examn = do
|
||||
<*> preview (resultCourseNote . _entityVal . _courseUserNoteNote)
|
||||
dbtCsvDecode = Just DBTCsvDecode
|
||||
{ dbtCsvRowKey = \csv -> do
|
||||
uid <- lift $ view _2 <$> guessUser csv
|
||||
uid <- lift $ view _2 <$> guessUser' csv
|
||||
fmap E.Value . MaybeT . getKeyBy $ UniqueExamRegistration eid uid
|
||||
, dbtCsvComputeActions = \case
|
||||
DBCsvDiffMissing{dbCsvOldKey}
|
||||
@ -632,7 +633,7 @@ postEUsersR tid ssh csh examn = do
|
||||
DBCsvDiffNew{dbCsvNewKey = Just _}
|
||||
-> error "An UniqueExamRegistration could be found, but the ExamRegistrationKey is not among the existing keys"
|
||||
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
|
||||
(isPart, uid) <- lift $ guessUser dbCsvNew
|
||||
(isPart, uid) <- lift $ guessUser' dbCsvNew
|
||||
if
|
||||
| isPart -> do
|
||||
yieldM $ ExamUserCsvRegisterData <$> pure uid <*> lookupOccurrence dbCsvNew
|
||||
@ -930,37 +931,17 @@ postEUsersR tid ssh csh examn = do
|
||||
registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
|
||||
where
|
||||
Entity _ User{..} = view resultUser $ existing ! registration
|
||||
|
||||
guessUser :: ExamUserTableCsv -> DB (Bool, UserId)
|
||||
guessUser ExamUserTableCsv{..} = $cachedHereBinary (csvEUserMatriculation, csvEUserName, csvEUserSurname) $ do
|
||||
users <- E.select . E.from $ \user -> do
|
||||
E.where_ . E.or $ catMaybes
|
||||
[ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvEUserMatriculation
|
||||
, (user E.^. UserDisplayName `E.hasInfix`) . E.val <$> csvEUserName
|
||||
, (user E.^. UserSurname `E.hasInfix`) . E.val <$> csvEUserSurname
|
||||
, (user E.^. UserFirstName `E.hasInfix`) . E.val <$> csvEUserFirstName
|
||||
]
|
||||
let isCourseParticipant = E.exists . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse
|
||||
E.&&. courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||
return (isCourseParticipant, user)
|
||||
let users' = reverse $ sortBy closeness users
|
||||
closeness :: (E.Value Bool, Entity User) -> (E.Value Bool, Entity User) -> Ordering
|
||||
closeness = mconcat $ catMaybes
|
||||
[ pure $ comparing (preview $ _2 . _entityVal . _userMatrikelnummer . only csvEUserMatriculation)
|
||||
, pure $ comparing (view _1)
|
||||
, csvEUserSurname <&> \surn -> comparing (preview $ _2 . _entityVal . _userSurname . to CI.mk . only (CI.mk surn))
|
||||
, csvEUserFirstName <&> \firstn -> comparing (preview $ _2 . _entityVal . _userFirstName . to CI.mk . only (CI.mk firstn))
|
||||
, csvEUserName <&> \dispn -> comparing (preview $ _2 . _entityVal . _userDisplayName . to CI.mk . only (CI.mk dispn))
|
||||
|
||||
guessUser' :: ExamUserTableCsv -> DB (Bool, UserId)
|
||||
guessUser' ExamUserTableCsv{..} = do
|
||||
let criteria = Set.fromList $ catMaybes
|
||||
[ GuessUserMatrikelnummer <$> csvEUserMatriculation
|
||||
, GuessUserDisplayName <$> csvEUserName
|
||||
, GuessUserSurname <$> csvEUserSurname
|
||||
, GuessUserFirstName <$> csvEUserFirstName
|
||||
]
|
||||
case users' of
|
||||
[(E.Value isPart, Entity uid _)]
|
||||
-> return (isPart, uid)
|
||||
(x@(E.Value isPart, Entity uid _) : x' : _)
|
||||
| GT <- x `closeness` x'
|
||||
-> return (isPart, uid)
|
||||
_other
|
||||
-> throwM ExamUserCsvExceptionNoMatchingUser
|
||||
pid <- maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria
|
||||
(,) <$> existsBy (UniqueParticipant pid examCourse) <*> pure pid
|
||||
|
||||
lookupOccurrence :: ExamUserTableCsv -> DB (Maybe ExamOccurrenceId)
|
||||
lookupOccurrence ExamUserTableCsv{..} = $cachedHereBinary (CI.foldedCase <$> csvEUserOccurrence) . for csvEUserOccurrence $ \occName -> do
|
||||
@ -971,7 +952,7 @@ postEUsersR tid ssh csh examn = do
|
||||
|
||||
lookupStudyFeatures :: ExamUserTableCsv -> DB (Maybe StudyFeaturesId)
|
||||
lookupStudyFeatures csv@ExamUserTableCsv{..} = do
|
||||
uid <- view _2 <$> guessUser csv
|
||||
uid <- view _2 <$> guessUser' csv
|
||||
oldFeatures <- getBy $ UniqueParticipant uid examCourse
|
||||
studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) ->
|
||||
E.distinctOnOrderBy [ E.asc (studyFeatures E.^. StudyFeaturesField)
|
||||
|
||||
@ -6,3 +6,4 @@ import Handler.ExamOffice.Exams as Handler.ExamOffice
|
||||
import Handler.ExamOffice.Fields as Handler.ExamOffice
|
||||
import Handler.ExamOffice.Users as Handler.ExamOffice
|
||||
import Handler.ExamOffice.Exam as Handler.ExamOffice
|
||||
import Handler.ExamOffice.ExternalExam as Handler.ExamOffice
|
||||
|
||||
@ -140,15 +140,15 @@ resultSynchronised :: Traversal' ExamUserTableData (UserDisplayName, UserSurname
|
||||
resultSynchronised = _dbrOutput . _9 . traverse
|
||||
|
||||
data ExamUserTableCsv = ExamUserTableCsv
|
||||
{ csvEUserSurname :: Text
|
||||
, csvEUserFirstName :: Text
|
||||
, csvEUserName :: Text
|
||||
, csvEUserMatriculation :: Maybe Text
|
||||
, csvEUserField :: Maybe Text
|
||||
, csvEUserDegree :: Maybe Text
|
||||
, csvEUserSemester :: Maybe Int
|
||||
{ csvEUserSurname :: Text
|
||||
, csvEUserFirstName :: Text
|
||||
, csvEUserName :: Text
|
||||
, csvEUserMatriculation :: Maybe Text
|
||||
, csvEUserField :: Maybe Text
|
||||
, csvEUserDegree :: Maybe Text
|
||||
, csvEUserSemester :: Maybe Int
|
||||
, csvEUserOccurrenceStart :: Maybe ZonedTime
|
||||
, csvEUserExamResult :: ExamResultPassedGrade
|
||||
, csvEUserExamResult :: ExamResultPassedGrade
|
||||
}
|
||||
deriving (Generic)
|
||||
makeLenses_ ''ExamUserTableCsv
|
||||
@ -396,7 +396,7 @@ postEGradesR tid ssh csh examn = do
|
||||
dbtIdent = "exam-results"
|
||||
dbtCsvEncode = Just DBTCsvEncode
|
||||
{ dbtCsvExportForm = ExamUserCsvExportData
|
||||
<$> apopt checkBoxField (fslI MsgExamUserMarkSynchronisedCsv) (Just True)
|
||||
<$> apopt checkBoxField (fslI MsgExamUserMarkSynchronisedCsv & setTooltip MsgExamUserMarkSynchronisedCsvTip) (Just False)
|
||||
, dbtCsvDoEncode = \ExamUserCsvExportData{..} -> C.mapM $ \(E.Value k, row) -> do
|
||||
when csvEUserMarkSynchronised $ markSynced k
|
||||
return $ ExamUserTableCsv
|
||||
@ -437,6 +437,7 @@ postEGradesR tid ssh csh examn = do
|
||||
whenIsJust usersResult join
|
||||
|
||||
closeWgt <- examCloseWidget (SomeRoute $ CExamR tid ssh csh examn EGradesR) eId
|
||||
hasUsers <- hasReadAccessTo $ CExamR tid ssh csh examn EUsersR
|
||||
|
||||
siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamOfficeExamUsersHeading) $ do
|
||||
setTitleI $ prependCourseTitle tid ssh csh MsgExamOfficeExamUsersHeading
|
||||
|
||||
@ -8,6 +8,7 @@ import Import
|
||||
|
||||
import Handler.Utils
|
||||
import qualified Handler.Utils.ExamOffice.Exam as Exam
|
||||
import qualified Handler.Utils.ExamOffice.ExternalExam as ExternalExam
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
@ -15,60 +16,81 @@ import qualified Database.Esqueleto.Utils as E
|
||||
import qualified Colonnade
|
||||
|
||||
|
||||
type ExamsTableExpr = E.SqlExpr (Entity Exam)
|
||||
`E.InnerJoin` E.SqlExpr (Entity Course)
|
||||
type ExamsTableExpr = ( E.SqlExpr (Maybe (Entity Exam))
|
||||
`E.InnerJoin` E.SqlExpr (Maybe (Entity Course))
|
||||
)
|
||||
`E.FullOuterJoin` E.SqlExpr (Maybe (Entity ExternalExam))
|
||||
|
||||
type ExamsTableData = DBRow ( Entity Exam
|
||||
, Entity Course
|
||||
type ExamsTableData = DBRow ( Either (Entity ExternalExam) (Entity Exam, Entity Course)
|
||||
, Natural, Natural
|
||||
)
|
||||
|
||||
queryExam :: Getter ExamsTableExpr (E.SqlExpr (Entity Exam))
|
||||
queryExam = to $(E.sqlIJproj 2 1)
|
||||
queryExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Exam)))
|
||||
queryExam = to $ $(E.sqlIJproj 2 1) . $(E.sqlFOJproj 2 1)
|
||||
|
||||
queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Entity Course))
|
||||
queryCourse = to $(E.sqlIJproj 2 2)
|
||||
queryCourse :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity Course)))
|
||||
queryCourse = to $ $(E.sqlIJproj 2 2) . $(E.sqlFOJproj 2 1)
|
||||
|
||||
queryExternalExam :: Getter ExamsTableExpr (E.SqlExpr (Maybe (Entity ExternalExam)))
|
||||
queryExternalExam = to $(E.sqlFOJproj 2 2)
|
||||
|
||||
querySynchronised :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Natural))
|
||||
querySynchronised office = to . runReader $ do
|
||||
exam <- view queryExam
|
||||
exam' <- view queryExam
|
||||
externalExam' <- view queryExternalExam
|
||||
let
|
||||
synchronised = E.subSelectCount . E.from $ \examResult -> do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
|
||||
examSynchronised examId = E.subSelectCount . E.from $ \examResult -> do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. examId
|
||||
E.where_ $ Exam.examOfficeExamResultAuth office examResult
|
||||
E.where_ $ Exam.resultIsSynced office examResult
|
||||
return synchronised
|
||||
externalExamSynchronised externalExamId = E.subSelectCount . E.from $ \externalExamResult -> do
|
||||
E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
|
||||
E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
|
||||
E.where_ $ ExternalExam.resultIsSynced office externalExamResult
|
||||
return $ E.maybe (E.val 0) examSynchronised (exam' E.?. ExamId) E.+. E.maybe (E.val 0) externalExamSynchronised (externalExam' E.?. ExternalExamId)
|
||||
|
||||
queryResults :: E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Natural))
|
||||
queryResults office = to . runReader $ do
|
||||
exam <- view queryExam
|
||||
exam' <- view queryExam
|
||||
externalExam' <- view queryExternalExam
|
||||
let
|
||||
results = E.subSelectCount . E.from $ \examResult -> do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
|
||||
results examId = E.subSelectCount . E.from $ \examResult -> do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. examId
|
||||
E.where_ $ Exam.examOfficeExamResultAuth office examResult
|
||||
return results
|
||||
externalResults externalExamId = E.subSelectCount . E.from $ \externalExamResult -> do
|
||||
E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
|
||||
E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
|
||||
return $ E.maybe (E.val 0) results (exam' E.?. ExamId) E.+. E.maybe (E.val 0) externalResults (externalExam' E.?. ExternalExamId)
|
||||
|
||||
queryIsSynced :: UTCTime -> E.SqlExpr (E.Value UserId) -> Getter ExamsTableExpr (E.SqlExpr (E.Value Bool))
|
||||
queryIsSynced now office = to . runReader $ do
|
||||
exam <- view queryExam
|
||||
exam' <- view queryExam
|
||||
externalExam' <- view queryExternalExam
|
||||
let
|
||||
synchronised = E.not_ . E.exists . E.from $ \examResult -> do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
|
||||
examSynchronised examId = E.not_ . E.exists . E.from $ \examResult -> do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. examId
|
||||
E.where_ $ Exam.examOfficeExamResultAuth office examResult
|
||||
E.where_ . E.not_ $ Exam.resultIsSynced office examResult
|
||||
open = E.maybe E.true (E.>. E.val now) $ exam E.^. ExamClosed
|
||||
return $ synchronised E.||. open
|
||||
externalExamSynchronised externalExamId = E.not_ . E.exists . E.from $ \externalExamResult -> do
|
||||
E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. externalExamId
|
||||
E.where_ $ ExternalExam.examOfficeExternalExamResultAuth office externalExamResult
|
||||
E.where_ . E.not_ $ ExternalExam.resultIsSynced office externalExamResult
|
||||
open examClosed' = E.maybe E.true (E.>. E.val now) $ examClosed'
|
||||
return $ E.maybe E.false examSynchronised (exam' E.?. ExamId) E.||. E.maybe E.false open (exam' E.?. ExamClosed) E.||. E.maybe E.false externalExamSynchronised (externalExam' E.?. ExternalExamId)
|
||||
|
||||
|
||||
resultExam :: Lens' ExamsTableData (Entity Exam)
|
||||
resultExam = _dbrOutput . _1
|
||||
resultExam :: Traversal' ExamsTableData (Entity Exam)
|
||||
resultExam = _dbrOutput . _1 . _Right . _1
|
||||
|
||||
resultCourse :: Lens' ExamsTableData (Entity Course)
|
||||
resultCourse = _dbrOutput . _2
|
||||
resultCourse :: Traversal' ExamsTableData (Entity Course)
|
||||
resultCourse = _dbrOutput . _1 . _Right . _2
|
||||
|
||||
resultExternalExam :: Traversal' ExamsTableData (Entity ExternalExam)
|
||||
resultExternalExam = _dbrOutput . _1 . _Left
|
||||
|
||||
resultSynchronised, resultResults :: Lens' ExamsTableData Natural
|
||||
resultSynchronised = _dbrOutput . _3
|
||||
resultResults = _dbrOutput . _4
|
||||
resultSynchronised = _dbrOutput . _2
|
||||
resultResults = _dbrOutput . _3
|
||||
|
||||
resultIsSynced :: Getter ExamsTableData Bool
|
||||
resultIsSynced = to $ (>=) <$> view resultSynchronised <*> view resultResults
|
||||
@ -90,6 +112,10 @@ getEOExamsR = do
|
||||
courseLink :: Course -> SomeRoute UniWorX
|
||||
courseLink Course{..}
|
||||
= SomeRoute $ CourseR courseTerm courseSchool courseShorthand CShowR
|
||||
|
||||
externalExamLink :: ExternalExam -> SomeRoute UniWorX
|
||||
externalExamLink ExternalExam{..}
|
||||
= SomeRoute $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEGradesR
|
||||
|
||||
querySynchronised' = querySynchronised $ E.val uid
|
||||
queryResults' = queryResults $ E.val uid
|
||||
@ -100,34 +126,48 @@ getEOExamsR = do
|
||||
dbtSQLQuery = runReaderT $ do
|
||||
exam <- view queryExam
|
||||
course <- view queryCourse
|
||||
externalExam <- view queryExternalExam
|
||||
|
||||
synchronised <- view querySynchronised'
|
||||
results <- view queryResults'
|
||||
|
||||
lift $ do
|
||||
E.on $ exam E.^. ExamCourse E.==. course E.^. CourseId
|
||||
E.on E.false
|
||||
E.on $ exam E.?. ExamCourse E.==. course E.?. CourseId
|
||||
|
||||
E.where_ $ results E.>. E.val 0
|
||||
E.where_ $ (E.not_ (E.isNothing $ exam E.?. ExamId) E.&&. E.not_ (E.isNothing $ course E.?. CourseId) E.&&. E.isNothing (externalExam E.?. ExternalExamId))
|
||||
E.||. ( E.isNothing (exam E.?. ExamId) E.&&. E.isNothing (course E.?. CourseId) E.&&. E.not_ (E.isNothing $ externalExam E.?. ExternalExamId))
|
||||
|
||||
return (exam, course, synchronised, results)
|
||||
dbtRowKey = views queryExam (E.^. ExamId)
|
||||
return (exam, course, externalExam, synchronised, results)
|
||||
dbtRowKey = views ($(multifocusG 2) queryExam queryExternalExam) (bimap (E.?. ExamId) (E.?. ExternalExamId))
|
||||
|
||||
dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) ExamsTableData
|
||||
dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $ do
|
||||
exam <- view $ _1 . _entityVal
|
||||
course <- view $ _2 . _entityVal
|
||||
exam <- view _1
|
||||
course <- view _2
|
||||
externalExam <- view _3
|
||||
|
||||
guard =<< hasReadAccessTo (urlRoute $ examLink course exam)
|
||||
case (exam, course, externalExam) of
|
||||
(Just exam', Just course', Nothing) -> do
|
||||
guard =<< hasReadAccessTo (urlRoute $ examLink (entityVal course') (entityVal exam'))
|
||||
|
||||
(,,,)
|
||||
<$> view _1 <*> view _2 <*> view (_3 . _Value) <*> view (_4 . _Value)
|
||||
(,,)
|
||||
<$> pure (Right (exam', course')) <*> view (_4 . _Value) <*> view (_5 . _Value)
|
||||
(Nothing, Nothing, Just externalExam') -> do
|
||||
guard =<< hasReadAccessTo (urlRoute $ externalExamLink (entityVal externalExam'))
|
||||
|
||||
(,,)
|
||||
<$> pure (Left externalExam') <*> view (_4 . _Value) <*> view (_5 . _Value)
|
||||
_other -> return $ error "Got exam & externalExam in same result"
|
||||
|
||||
|
||||
colSynced = Colonnade.singleton (fromSortable . Sortable (Just "synced") $ i18nCell MsgExamSynchronised) $ \x -> flip runReader x $ do
|
||||
Entity _ Exam{examClosed} <- view resultExam
|
||||
mExam <- preview resultExam
|
||||
|
||||
if
|
||||
| NTop examClosed > NTop (Just now)
|
||||
| Just (Entity _ Exam{examClosed}) <- mExam
|
||||
, NTop examClosed > NTop (Just now)
|
||||
-> return . cell $ toWidget iconNew
|
||||
| otherwise
|
||||
-> do
|
||||
@ -151,26 +191,28 @@ getEOExamsR = do
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat
|
||||
[ colSynced
|
||||
, anchorColonnade (views ($(multifocusG 2) (resultCourse . _entityVal) (resultExam . _entityVal)) (uncurry examLink))
|
||||
$ colExamName (resultExam . _entityVal . _examName)
|
||||
, colExamTime (resultExam . _entityVal . $(multifocusG 2) _examStart _examEnd)
|
||||
, colExamFinishedOffice (resultExam . _entityVal . _examFinished)
|
||||
, colExamClosed (resultExam . _entityVal . _examClosed)
|
||||
, anchorColonnade (views (resultCourse . _entityVal) courseLink)
|
||||
$ colCourseName (resultCourse . _entityVal . _courseName)
|
||||
, colSchool (resultCourse . _entityVal . _courseSchool)
|
||||
, colTermShort (resultCourse . _entityVal . _courseTerm)
|
||||
, maybeAnchorColonnade ( runMaybeT $ mpreview ($(multifocusG 2) (pre $ resultCourse . _entityVal) (pre $ resultExam . _entityVal) . to (uncurry $ liftA2 examLink) . _Just)
|
||||
<|> mpreviews (resultExternalExam . _entityVal) externalExamLink
|
||||
)
|
||||
$ emptyOpticColonnade (resultExam . _entityVal . _examName <> resultExternalExam . _entityVal . _externalExamExamName) colExamName
|
||||
, emptyOpticColonnade (resultExam . _entityVal . $(multifocusG 2) _examStart _examEnd) colExamTime
|
||||
, emptyOpticColonnade (resultExam . _entityVal . _examFinished) colExamFinishedOffice
|
||||
, emptyOpticColonnade (resultExam . _entityVal . _examClosed) colExamClosed
|
||||
, maybeAnchorColonnade (previews (resultCourse . _entityVal) courseLink)
|
||||
$ emptyOpticColonnade (resultCourse . _entityVal . _courseName <> resultExternalExam . _entityVal . _externalExamCourseName) colCourseName
|
||||
, emptyOpticColonnade (resultCourse . _entityVal . _courseSchool <> resultExternalExam . _entityVal . _externalExamSchool) colSchool
|
||||
, emptyOpticColonnade (resultCourse . _entityVal . _courseTerm <> resultExternalExam . _entityVal . _externalExamTerm) colTermShort
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ singletonMap "synced" . SortColumn $ (E./.) <$> view querySynchronised' <*> view queryResults'
|
||||
, singletonMap "is-synced" . SortColumn $ view queryIsSynced'
|
||||
, sortExamName (queryExam . to (E.^. ExamName))
|
||||
, sortExamTime (queryExam . $(multifocusG 2) (to (E.^. ExamStart)) (to (E.^. ExamEnd)))
|
||||
, sortExamFinished (queryExam . to (E.^. ExamFinished))
|
||||
, sortExamClosed (queryExam . to (E.^. ExamClosed))
|
||||
, sortCourseName (queryCourse . to (E.^. CourseName))
|
||||
, sortSchool (queryCourse . to (E.^. CourseSchool))
|
||||
, sortTerm (queryCourse . to (E.^. CourseTerm))
|
||||
, sortExamName (to $ E.unsafeCoalesce . sequence [views queryExam (E.?. ExamName), views queryExternalExam (E.?. ExternalExamExamName)])
|
||||
, sortExamTime (queryExam . $(multifocusG 2) (to $ E.joinV . (E.?. ExamStart)) (to $ E.joinV . (E.?. ExamEnd)))
|
||||
, sortExamFinished (queryExam . to (E.joinV . (E.?. ExamFinished)))
|
||||
, sortExamClosed (queryExam . to (E.joinV . (E.?. ExamClosed)))
|
||||
, sortCourseName (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseName), views queryExternalExam (E.?. ExternalExamCourseName)])
|
||||
, sortSchool (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseSchool), views queryExternalExam (E.?. ExternalExamSchool)])
|
||||
, sortTerm (to $ E.unsafeCoalesce . sequence [views queryCourse (E.?. CourseTerm), views queryExternalExam (E.?. ExternalExamTerm)])
|
||||
]
|
||||
|
||||
dbtFilter = mconcat
|
||||
|
||||
33
src/Handler/ExamOffice/ExternalExam.hs
Normal file
33
src/Handler/ExamOffice/ExternalExam.hs
Normal file
@ -0,0 +1,33 @@
|
||||
module Handler.ExamOffice.ExternalExam
|
||||
( getEEGradesR, postEEGradesR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import Handler.Utils.ExternalExam.Users
|
||||
|
||||
getEEGradesR, postEEGradesR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||
getEEGradesR = postEEGradesR
|
||||
postEEGradesR tid ssh coursen examn = do
|
||||
(usersResult, table) <- runDB $ do
|
||||
eExam <- getBy404 $ UniqueExternalExam tid ssh coursen examn
|
||||
(usersResult, examUsersTable) <- makeExternalExamUsersTable EEUMGrades eExam
|
||||
|
||||
usersResult' <- formResultMaybe usersResult $ \case
|
||||
(ExternalExamUserMarkSynchronisedData, selectedResults) -> do
|
||||
forM_ selectedResults externalExamResultMarkSynchronised
|
||||
return . Just $ do
|
||||
addMessageI Success $ MsgExamUserMarkedSynchronised (length selectedResults)
|
||||
redirect $ EExamR tid ssh coursen examn EEGradesR
|
||||
|
||||
return (usersResult', examUsersTable)
|
||||
|
||||
whenIsJust usersResult join
|
||||
|
||||
hasUsers <- hasReadAccessTo $ EExamR tid ssh coursen examn EEUsersR
|
||||
|
||||
siteLayoutMsg (MsgExternalExamGrades coursen examn) $ do
|
||||
setTitleI MsgBreadcrumbExternalExamGrades
|
||||
$(widgetFile "exam-office/externalExamGrades")
|
||||
@ -74,7 +74,7 @@ examOfficeUserInvitationConfig = InvitationConfig{..}
|
||||
return InvitationTokenConfig{..}
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ _ _ = pure (JunctionExamOfficeUser, ())
|
||||
invitationInsertHook _ _ ExamOfficeUser{..} _ act = do
|
||||
invitationInsertHook _ _ _ ExamOfficeUser{..} _ act = do
|
||||
res <- act
|
||||
audit $ TransactionExamOfficeUserAdd examOfficeUserOffice examOfficeUserUser
|
||||
return res
|
||||
|
||||
10
src/Handler/ExternalExam.hs
Normal file
10
src/Handler/ExternalExam.hs
Normal file
@ -0,0 +1,10 @@
|
||||
module Handler.ExternalExam
|
||||
( module Handler.ExternalExam
|
||||
) where
|
||||
|
||||
import Handler.ExternalExam.List as Handler.ExternalExam
|
||||
import Handler.ExternalExam.New as Handler.ExternalExam
|
||||
import Handler.ExternalExam.Show as Handler.ExternalExam
|
||||
import Handler.ExternalExam.Edit as Handler.ExternalExam
|
||||
import Handler.ExternalExam.Users as Handler.ExternalExam
|
||||
import Handler.ExternalExam.StaffInvite as Handler.ExternalExam
|
||||
98
src/Handler/ExternalExam/Edit.hs
Normal file
98
src/Handler/ExternalExam/Edit.hs
Normal file
@ -0,0 +1,98 @@
|
||||
module Handler.ExternalExam.Edit
|
||||
( getEEEditR, postEEEditR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Invitations
|
||||
|
||||
import Handler.ExternalExam.Form
|
||||
import Handler.ExternalExam.StaffInvite
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import Jobs.Queue
|
||||
|
||||
|
||||
getEEEditR, postEEEditR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||
getEEEditR = postEEEditR
|
||||
postEEEditR tid ssh coursen examn = do
|
||||
(Entity eeId ExternalExam{..}, schools, staff) <- runDB $ do
|
||||
eExam@(Entity eeId _) <- getBy404 $ UniqueExternalExam tid ssh coursen examn
|
||||
schools <- setOf (folded . _entityVal . _externalExamOfficeSchoolSchool) <$> selectList [ ExternalExamOfficeSchoolExam ==. eeId ] []
|
||||
actualStaff <- selectList [ ExternalExamStaffExam ==. eeId ] []
|
||||
invitedStaff <- sourceInvitationsF @ExternalExamStaff eeId
|
||||
let staff = setOf (folded . _entityVal . _externalExamStaffUser . re _Right) actualStaff
|
||||
<> Set.mapMonotonic Left (Map.keysSet invitedStaff)
|
||||
return (eExam, schools, staff)
|
||||
|
||||
let
|
||||
template = ExternalExamForm
|
||||
{ eefTerm = tid
|
||||
, eefSchool = ssh
|
||||
, eefCourseName = coursen
|
||||
, eefExamName = examn
|
||||
, eefDefaultTime = externalExamDefaultTime
|
||||
, eefShowGrades = externalExamShowGrades
|
||||
, eefOfficeSchools = schools
|
||||
, eefStaff = staff
|
||||
}
|
||||
|
||||
((examResult, examWidget'), examEnctype) <- runFormPost . externalExamForm $ Just template
|
||||
|
||||
formResult examResult $ \ExternalExamForm{..} -> do
|
||||
replaceRes <- runDBJobs $ do
|
||||
replaceRes <- replaceUnique eeId ExternalExam
|
||||
{ externalExamTerm = eefTerm
|
||||
, externalExamSchool = eefSchool
|
||||
, externalExamCourseName = eefCourseName
|
||||
, externalExamExamName = eefExamName
|
||||
, externalExamDefaultTime = eefDefaultTime
|
||||
, externalExamShowGrades = eefShowGrades
|
||||
}
|
||||
when (is _Nothing replaceRes) $ do
|
||||
audit $ TransactionExternalExamEdit eeId
|
||||
|
||||
forM_ (eefStaff `setSymmDiff` staff) $ \change -> if
|
||||
| change `Set.member` eefStaff -> case change of
|
||||
Left invEmail -> do
|
||||
audit $ TransactionExternalExamStaffInviteEdit eeId invEmail
|
||||
sinkInvitationsF externalExamStaffInvitationConfig
|
||||
[(invEmail, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff))]
|
||||
Right staffUid -> do
|
||||
audit $ TransactionExternalExamStaffEdit eeId staffUid
|
||||
insert_ $ ExternalExamStaff staffUid eeId
|
||||
| otherwise -> case change of
|
||||
Left invEmail -> do
|
||||
audit $ TransactionExternalExamStaffInviteDelete eeId invEmail
|
||||
deleteInvitation @ExternalExamStaff eeId invEmail
|
||||
Right staffUid -> do
|
||||
audit $ TransactionExternalExamStaffDelete eeId staffUid
|
||||
deleteBy $ UniqueExternalExamStaff eeId staffUid
|
||||
|
||||
forM_ (eefOfficeSchools `setSymmDiff` schools) $ \change -> if
|
||||
| change `Set.member` eefOfficeSchools -> do
|
||||
audit $ TransactionExternalExamOfficeSchoolEdit eeId change
|
||||
insert_ $ ExternalExamOfficeSchool change eeId
|
||||
| otherwise -> do
|
||||
audit $ TransactionExternalExamOfficeSchoolDelete eeId change
|
||||
deleteBy $ UniqueExternalExamOfficeSchool eeId change
|
||||
return replaceRes
|
||||
|
||||
case replaceRes of
|
||||
Nothing -> do
|
||||
addMessageI Success $ MsgExternalExamEdited eefCourseName eefExamName
|
||||
redirect $ EExamR eefTerm eefSchool eefCourseName eefExamName EEShowR
|
||||
Just _ ->
|
||||
addMessageI Error $ MsgExternalExamExists eefCourseName eefExamName
|
||||
|
||||
let heading = MsgExternalExamEdit coursen examn
|
||||
|
||||
siteLayoutMsg heading $ do
|
||||
setTitleI heading
|
||||
wrapForm examWidget' def
|
||||
{ formAction = Just . SomeRoute $ EExamR tid ssh coursen examn EEEditR
|
||||
, formEncoding = examEnctype
|
||||
}
|
||||
115
src/Handler/ExternalExam/Form.hs
Normal file
115
src/Handler/ExternalExam/Form.hs
Normal file
@ -0,0 +1,115 @@
|
||||
module Handler.ExternalExam.Form
|
||||
( ExternalExamForm(..)
|
||||
, externalExamForm
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Handler.Utils
|
||||
|
||||
import Handler.ExternalExam.StaffInvite ()
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import Data.Map ((!))
|
||||
|
||||
import qualified Control.Monad.State.Class as State
|
||||
|
||||
|
||||
data ExternalExamForm = ExternalExamForm
|
||||
{ eefTerm :: TermId
|
||||
, eefSchool :: SchoolId
|
||||
, eefCourseName :: CI Text
|
||||
, eefExamName :: CI Text
|
||||
, eefDefaultTime :: Maybe UTCTime
|
||||
, eefShowGrades :: Bool
|
||||
, eefOfficeSchools :: Set SchoolId
|
||||
, eefStaff :: Set (Either UserEmail UserId)
|
||||
}
|
||||
|
||||
makeLenses_ ''ExternalExamForm
|
||||
|
||||
externalExamForm :: Maybe ExternalExamForm -> Form ExternalExamForm
|
||||
externalExamForm template = validateForm validateExternalExam $ \html -> do
|
||||
uid <- requireAuthId
|
||||
cRoute <- fromMaybe (error "tutorialForm called from 404-Handler") <$> getCurrentRoute
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
|
||||
let termsField = case template of
|
||||
Just template' -> termsSetField [eefTerm template']
|
||||
_other -> termsAllowedField
|
||||
|
||||
(lecturerSchools, adminSchools, oldSchool) <- liftHandler . runDB $ do
|
||||
lecturerSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolLecturer]] []
|
||||
protoAdminSchools <- map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin]] []
|
||||
adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
|
||||
let oldSchool = eefSchool <$> template
|
||||
return (lecturerSchools, adminSchools, oldSchool)
|
||||
let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
|
||||
|
||||
flip (renderAForm FormStandard) html $ ExternalExamForm
|
||||
<$> areq termsField (fslI MsgExternalExamSemester) (eefTerm <$> template)
|
||||
<*> areq (schoolFieldFor userSchools) (fslI MsgExternalExamSchool) (eefSchool <$> template)
|
||||
<*> areq (textField & cfStrip & cfCI) (fslI MsgExternalExamCourseName & setTooltip MsgExternalExamCourseNameTip & addPlaceholder (mr MsgExternalExamCourseNamePlaceholder)) (eefCourseName <$> template)
|
||||
<*> areq (textField & cfStrip & cfCI) (fslI MsgExternalExamExamName & setTooltip MsgExternalExamExamNameTip & addPlaceholder (mr MsgExternalExamExamNamePlaceholder)) (eefExamName <$> template)
|
||||
<*> aopt utcTimeField (fslI MsgExternalExamDefaultTime & setTooltip MsgExternalExamDefaultTimeTip & addPlaceholder (mr MsgExternalExamDefaultTimePlaceholder)) (eefDefaultTime <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgExternalExamShowGrades & setTooltip MsgExternalExamShowGradesTip) (eefShowGrades <$> template)
|
||||
<*> (Set.fromList <$> officeSchoolForm cRoute (Set.toList . eefOfficeSchools <$> template))
|
||||
<*> (Set.fromList <$> staffForm cRoute ((Set.toList . eefStaff <$> template) <|> pure (pure $ Right uid)))
|
||||
where
|
||||
officeSchoolForm cRoute = massInputAccumA miAdd miCell miButtonAction miLayout miIdent fSettings fRequired
|
||||
where
|
||||
miAdd mkUnique submitView csrf = do
|
||||
(schoolRes, addView) <- mpopt schoolField ("" & addName (mkUnique "school")) Nothing
|
||||
let schoolRes' = schoolRes <&> \newDat oldDat -> FormSuccess (guardOn (newDat `notElem` oldDat) newDat)
|
||||
return (schoolRes', $(widgetFile "external-exam/schoolMassInput/add"))
|
||||
miCell ssh = do
|
||||
School{..} <- liftHandler . runDB $ getJust ssh
|
||||
$(widgetFile "external-exam/schoolMassInput/cell")
|
||||
miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
|
||||
miButtonAction = Just . SomeRoute . (cRoute :#:)
|
||||
miLayout :: MassInputLayout ListLength SchoolId ()
|
||||
miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "external-exam/schoolMassInput/layout")
|
||||
miIdent :: Text
|
||||
miIdent = "external-exams-school"
|
||||
fSettings = fslI MsgExternalExamExamOfficeSchools & setTooltip (UniWorXMessages [SomeMessage MsgExternalExamExamOfficeSchoolsTip, SomeMessage MsgMassInputTip])
|
||||
fRequired = False
|
||||
staffForm cRoute = massInputAccumA miAdd miCell miButtonAction miLayout miIdent fSettings fRequired
|
||||
where
|
||||
miAdd mkUnique submitView csrf = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
(usersRes, addView) <- mpreq (multiUserField False Nothing) ("" & addName (mkUnique "email")) Nothing
|
||||
let
|
||||
usersRes' = usersRes <&> \newDat oldDat -> if
|
||||
| existing <- newDat `Set.intersection` Set.fromList oldDat
|
||||
, not $ Set.null existing
|
||||
-> FormFailure [mr MsgExternalExamStaffAlreadyAdded]
|
||||
| otherwise
|
||||
-> FormSuccess $ Set.toList newDat
|
||||
return (usersRes', $(widgetFile "external-exam/staffMassInput/add"))
|
||||
miCell (Left email) = do
|
||||
invWarnMsg <- messageI Warning MsgEmailInvitationWarning
|
||||
$(widgetFile "external-exam/staffMassInput/cellInvitation")
|
||||
miCell (Right userId) = do
|
||||
User{..} <- liftHandler . runDB $ getJust userId
|
||||
$(widgetFile "external-exam/staffMassInput/cellKnown")
|
||||
miButtonAction :: forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)
|
||||
miButtonAction = Just . SomeRoute . (cRoute :#:)
|
||||
miLayout :: MassInputLayout ListLength (Either UserEmail UserId) ()
|
||||
miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "external-exam/staffMassInput/layout")
|
||||
miIdent :: Text
|
||||
miIdent = "external-exams-staff"
|
||||
fSettings = fslI MsgExternalExamStaff & setTooltip (UniWorXMessages [SomeMessage MsgExternalExamStaffTip, SomeMessage MsgMassInputTip])
|
||||
fRequired = True
|
||||
|
||||
validateExternalExam :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => FormValidator ExternalExamForm m ()
|
||||
validateExternalExam = do
|
||||
State.modify $ \eeForm -> eeForm & over _eefOfficeSchools (Set.delete $ eeForm ^. _eefSchool)
|
||||
|
||||
ExternalExamForm{..} <- State.get
|
||||
|
||||
isAdmin <- hasWriteAccessTo $ SchoolR eefSchool SchoolEditR
|
||||
unless isAdmin $ do
|
||||
uid <- requireAuthId
|
||||
guardValidation MsgExternalExamUserMustBeStaff $ Right uid `Set.member` eefStaff
|
||||
|
||||
courseExists <- liftHandler . runDB . existsBy $ TermSchoolCourseName eefTerm eefSchool eefCourseName
|
||||
guardValidation MsgExternalExamCourseExists $ not courseExists
|
||||
81
src/Handler/ExternalExam/List.hs
Normal file
81
src/Handler/ExternalExam/List.hs
Normal file
@ -0,0 +1,81 @@
|
||||
module Handler.ExternalExam.List
|
||||
( getEExamListR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.Map as Map
|
||||
|
||||
|
||||
getEExamListR :: Handler Html
|
||||
getEExamListR = do
|
||||
mAuthId <- maybeAuthId
|
||||
|
||||
let
|
||||
examDBTable = DBTable{..}
|
||||
where
|
||||
resultEExam = _dbrOutput . _1
|
||||
resultSchool = _dbrOutput . _2
|
||||
|
||||
queryEExam = $(E.sqlIJproj 2 1)
|
||||
querySchool = $(E.sqlIJproj 2 2)
|
||||
|
||||
dbtSQLQuery (eexam `E.InnerJoin` school) = do
|
||||
E.on $ eexam E.^. ExternalExamSchool E.==. school E.^. SchoolId
|
||||
let
|
||||
isStaff
|
||||
| Just authId <- mAuthId
|
||||
= E.exists . E.from $ \eexamStaff ->
|
||||
E.where_ $ eexamStaff E.^. ExternalExamStaffExam E.==. eexam E.^. ExternalExamId
|
||||
E.&&. eexamStaff E.^. ExternalExamStaffUser E.==. E.val authId
|
||||
| otherwise
|
||||
= E.false
|
||||
isStudent
|
||||
| Just authId <- mAuthId
|
||||
= E.exists . E.from $ \eexamResult ->
|
||||
E.where_ $ eexamResult E.^. ExternalExamResultExam E.==. eexam E.^. ExternalExamId
|
||||
E.&&. eexamResult E.^. ExternalExamResultUser E.==. E.val authId
|
||||
| otherwise
|
||||
= E.false
|
||||
E.where_ $ isStaff E.||. isStudent
|
||||
|
||||
return (eexam, school)
|
||||
dbtRowKey = queryEExam >>> (E.^. ExternalExamId)
|
||||
dbtProj x@(view resultEExam -> Entity _ ExternalExam{..}) = do
|
||||
guardM . hasReadAccessTo $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEShowR
|
||||
return x
|
||||
dbtColonnade = widgetColonnade $ mconcat
|
||||
[ sortable (Just "term") (i18nCell MsgTerm) $ \(view resultEExam -> Entity _ ExternalExam{..}) -> i18nCell . ShortTermIdentifier $ unTermKey externalExamTerm
|
||||
, sortable (Just "school") (i18nCell MsgSchool) $ \(view resultSchool -> Entity _ School{..}) -> i18nCell schoolName
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $ \(view resultEExam -> Entity _ ExternalExam{..}) -> i18nCell externalExamCourseName
|
||||
, sortable (Just "name") (i18nCell MsgExamName) $ \(view resultEExam -> Entity _ ExternalExam{..}) -> anchorCell (EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEShowR) externalExamExamName
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ ("term", SortColumn $ queryEExam >>> (E.^. ExternalExamTerm))
|
||||
, ("school", SortColumn $ querySchool >>> (E.^. SchoolName))
|
||||
, ("course", SortColumn $ queryEExam >>> (E.^. ExternalExamCourseName))
|
||||
, ("name", SortColumn $ queryEExam >>> (E.^. ExternalExamExamName))
|
||||
]
|
||||
dbtFilter = Map.empty
|
||||
dbtFilterUI = const mempty
|
||||
dbtStyle = def
|
||||
dbtParams = def
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "external-exams"
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
examDBTableValidator = def
|
||||
& defaultSorting [SortDescBy "term", SortAscBy "school", SortAscBy "course", SortAscBy "name"]
|
||||
|
||||
examTable <- runDB $ dbTableWidget' examDBTableValidator examDBTable
|
||||
|
||||
let heading = MsgMenuExternalExamList
|
||||
|
||||
siteLayoutMsg heading $ do
|
||||
setTitleI heading
|
||||
examTable
|
||||
72
src/Handler/ExternalExam/New.hs
Normal file
72
src/Handler/ExternalExam/New.hs
Normal file
@ -0,0 +1,72 @@
|
||||
module Handler.ExternalExam.New
|
||||
( getEExamNewR, postEExamNewR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Jobs.Queue
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Invitations
|
||||
|
||||
import Handler.ExternalExam.StaffInvite
|
||||
import Handler.ExternalExam.Form
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
|
||||
getEExamNewR, postEExamNewR :: Handler Html
|
||||
getEExamNewR = postEExamNewR
|
||||
postEExamNewR = do
|
||||
((newExamResult, newExamWidget'), newExamEnctype) <- runFormPost $ externalExamForm Nothing
|
||||
|
||||
formResult newExamResult $ \ExternalExamForm{..} -> do
|
||||
insertRes <- runDBJobs $ do
|
||||
insertRes <- insertUnique ExternalExam
|
||||
{ externalExamTerm = eefTerm
|
||||
, externalExamSchool = eefSchool
|
||||
, externalExamCourseName = eefCourseName
|
||||
, externalExamExamName = eefExamName
|
||||
, externalExamDefaultTime = eefDefaultTime
|
||||
, externalExamShowGrades = eefShowGrades
|
||||
}
|
||||
whenIsJust insertRes $ \eeId -> do
|
||||
audit $ TransactionExternalExamEdit eeId
|
||||
|
||||
let eefOfficeSchools' = do
|
||||
externalExamOfficeSchoolSchool <- Set.toList eefOfficeSchools
|
||||
guard $ externalExamOfficeSchoolSchool /= eefSchool
|
||||
let externalExamOfficeSchoolExam = eeId
|
||||
return ExternalExamOfficeSchool{..}
|
||||
insertMany_ eefOfficeSchools'
|
||||
forM_ eefOfficeSchools' $ \ExternalExamOfficeSchool{..} ->
|
||||
audit $ TransactionExternalExamOfficeSchoolEdit eeId externalExamOfficeSchoolSchool
|
||||
|
||||
let (invites, adds) = partitionEithers $ Set.toList eefStaff
|
||||
eefStaff' = do
|
||||
externalExamStaffUser <- adds
|
||||
let externalExamStaffExam = eeId
|
||||
return ExternalExamStaff{..}
|
||||
insertMany_ eefStaff'
|
||||
forM_ eefStaff' $ \ExternalExamStaff{..} ->
|
||||
audit $ TransactionExternalExamStaffEdit eeId externalExamStaffUser
|
||||
|
||||
sinkInvitationsF externalExamStaffInvitationConfig $ map (, eeId, (InvDBDataExternalExamStaff, InvTokenDataExternalExamStaff)) invites
|
||||
forM_ invites $ \invEmail ->
|
||||
audit $ TransactionExternalExamStaffInviteEdit eeId invEmail
|
||||
return insertRes
|
||||
|
||||
case insertRes of
|
||||
Nothing -> addMessageI Error $ MsgExternalExamExists eefCourseName eefExamName
|
||||
Just _ -> do
|
||||
addMessageI Success $ MsgExternalExamCreated eefCourseName eefExamName
|
||||
redirect $ EExamR eefTerm eefSchool eefCourseName eefExamName EEShowR
|
||||
|
||||
let heading = MsgMenuExternalExamNew
|
||||
|
||||
siteLayoutMsg heading $ do
|
||||
setTitleI heading
|
||||
wrapForm newExamWidget' def
|
||||
{ formAction = Just $ SomeRoute EExamNewR
|
||||
, formEncoding = newExamEnctype
|
||||
}
|
||||
49
src/Handler/ExternalExam/Show.hs
Normal file
49
src/Handler/ExternalExam/Show.hs
Normal file
@ -0,0 +1,49 @@
|
||||
module Handler.ExternalExam.Show
|
||||
( getEEShowR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Invitations
|
||||
import Handler.ExternalExam.StaffInvite ()
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.Map as Map
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
|
||||
getEEShowR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||
getEEShowR tid ssh coursen examn = do
|
||||
mUid <- maybeAuthId
|
||||
|
||||
(Entity _ ExternalExam{..}, fmap entityVal -> mResult, School{..}, staff, addSchools) <- runDB $ do
|
||||
exam@(Entity eeId ExternalExam{..}) <- getBy404 $ UniqueExternalExam tid ssh coursen examn
|
||||
actualStaff <- E.select . E.from $ \(eeStaff `E.InnerJoin` user) -> do
|
||||
E.on $ eeStaff E.^. ExternalExamStaffUser E.==. user E.^. UserId
|
||||
E.where_ $ eeStaff E.^. ExternalExamStaffExam E.==. E.val eeId
|
||||
E.orderBy [E.asc $ user E.^. UserDisplayName]
|
||||
return user
|
||||
maySeeInvites <- hasReadAccessTo $ EExamR tid ssh coursen examn EEGradesR
|
||||
staffInvites <- if
|
||||
| maySeeInvites -> sourceInvitationsF @ExternalExamStaff eeId
|
||||
| otherwise -> return Map.empty
|
||||
let staff = map Right actualStaff ++ map Left (Map.keys staffInvites)
|
||||
addSchools <- E.select . E.from $ \(eeSchool `E.InnerJoin` school) -> do
|
||||
E.on $ eeSchool E.^. ExternalExamOfficeSchoolSchool E.==. school E.^. SchoolId
|
||||
E.where_ $ eeSchool E.^. ExternalExamOfficeSchoolExam E.==. E.val eeId
|
||||
E.orderBy [E.asc $ school E.^. SchoolName]
|
||||
return school
|
||||
school <- getJust externalExamSchool
|
||||
|
||||
mResult <- fmap join . for mUid $ getBy . UniqueExternalExamResult eeId
|
||||
|
||||
return (exam, mResult, school, staff, addSchools)
|
||||
|
||||
let heading = CI.original examn
|
||||
|
||||
siteLayoutMsg heading $ do
|
||||
setTitleI heading
|
||||
|
||||
$(widgetFile "external-exam-show")
|
||||
79
src/Handler/ExternalExam/StaffInvite.hs
Normal file
79
src/Handler/ExternalExam/StaffInvite.hs
Normal file
@ -0,0 +1,79 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Handler.ExternalExam.StaffInvite
|
||||
( externalExamStaffInvitationConfig
|
||||
, getEEStaffInviteR, postEEStaffInviteR
|
||||
, InvitableJunction(..), InvitationDBData(..), InvitationTokenData(..)
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils.Invitations
|
||||
|
||||
import Text.Hamlet (ihamlet)
|
||||
import Data.Aeson hiding (Result(..))
|
||||
|
||||
|
||||
instance IsInvitableJunction ExternalExamStaff where
|
||||
type InvitationFor ExternalExamStaff = ExternalExam
|
||||
data InvitableJunction ExternalExamStaff = JunctionExternalExamStaff
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
data InvitationDBData ExternalExamStaff = InvDBDataExternalExamStaff
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
data InvitationTokenData ExternalExamStaff = InvTokenDataExternalExamStaff
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
_InvitableJunction = iso
|
||||
(\ExternalExamStaff{..} -> (externalExamStaffUser, externalExamStaffExam, JunctionExternalExamStaff))
|
||||
(\(externalExamStaffUser, externalExamStaffExam, JunctionExternalExamStaff{}) -> ExternalExamStaff{..})
|
||||
|
||||
instance ToJSON (InvitableJunction ExternalExamStaff) where
|
||||
toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
|
||||
toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
|
||||
instance FromJSON (InvitableJunction ExternalExamStaff) where
|
||||
parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
|
||||
|
||||
instance ToJSON (InvitationDBData ExternalExamStaff) where
|
||||
toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
instance FromJSON (InvitationDBData ExternalExamStaff) where
|
||||
parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
|
||||
instance ToJSON (InvitationTokenData ExternalExamStaff) where
|
||||
toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
instance FromJSON (InvitationTokenData ExternalExamStaff) where
|
||||
parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
|
||||
|
||||
externalExamStaffInvitationConfig :: InvitationConfig ExternalExamStaff
|
||||
externalExamStaffInvitationConfig = InvitationConfig{..}
|
||||
where
|
||||
invitationRoute (Entity _ ExternalExam{..}) _ = return $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEStaffInviteR
|
||||
invitationResolveFor _ = do
|
||||
cRoute <- getCurrentRoute
|
||||
case cRoute of
|
||||
Just (EExamR tid ssh coursen examn EEStaffInviteR) ->
|
||||
getKeyBy404 $ UniqueExternalExam tid ssh coursen examn
|
||||
_other -> error "externalExamStaffInvitationConfig called from unsupported route"
|
||||
invitationSubject (Entity _ ExternalExam{..}) _ = return . SomeMessage $ MsgMailSubjectExternalExamStaffInvitation externalExamCourseName externalExamExamName
|
||||
invitationHeading (Entity _ ExternalExam{..}) _ = return . SomeMessage $ MsgExternalExamStaffInviteHeading externalExamCourseName externalExamExamName
|
||||
invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExternalExamStaffInviteExplanation}|]
|
||||
invitationTokenConfig _ _ = do
|
||||
itAuthority <- Right <$> liftHandler requireAuthId
|
||||
return $ InvitationTokenConfig itAuthority Nothing (Just Nothing) Nothing
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ (InvDBDataExternalExamStaff, _) _ = pure (JunctionExternalExamStaff, ())
|
||||
invitationInsertHook invEmail _ _ ExternalExamStaff{..} _ act = do
|
||||
res <- act
|
||||
|
||||
audit $ TransactionExternalExamStaffInviteDelete externalExamStaffExam invEmail
|
||||
audit $ TransactionExternalExamStaffEdit externalExamStaffExam externalExamStaffUser
|
||||
return res
|
||||
invitationSuccessMsg (Entity _ ExternalExam{..}) (Entity _ ExternalExamStaff{})
|
||||
= return . SomeMessage $ MsgExternalExamStaffInvitationAccepted externalExamCourseName externalExamExamName
|
||||
invitationUltDest (Entity _ ExternalExam{..}) _ = return . SomeRoute $ EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEShowR
|
||||
|
||||
|
||||
getEEStaffInviteR, postEEStaffInviteR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||
getEEStaffInviteR = postEEStaffInviteR
|
||||
postEEStaffInviteR = invitationR externalExamStaffInvitationConfig
|
||||
18
src/Handler/ExternalExam/Users.hs
Normal file
18
src/Handler/ExternalExam/Users.hs
Normal file
@ -0,0 +1,18 @@
|
||||
module Handler.ExternalExam.Users
|
||||
( getEEUsersR, postEEUsersR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils.ExternalExam.Users
|
||||
|
||||
getEEUsersR, postEEUsersR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
|
||||
getEEUsersR = postEEUsersR
|
||||
postEEUsersR tid ssh coursen examn = do
|
||||
(_, table) <- runDB $ do
|
||||
eExam <- getBy404 $ UniqueExternalExam tid ssh coursen examn
|
||||
makeExternalExamUsersTable EEUMUsers eExam
|
||||
|
||||
siteLayoutMsg (MsgExternalExamUsers coursen examn) $ do
|
||||
setTitleI MsgBreadcrumbExternalExamUsers
|
||||
table
|
||||
79
src/Handler/Participants.hs
Normal file
79
src/Handler/Participants.hs
Normal file
@ -0,0 +1,79 @@
|
||||
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||
module Handler.Participants
|
||||
( getParticipantsListR
|
||||
, getParticipantsR
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Handler.Utils.Csv
|
||||
import Handler.Utils.ContentDisposition
|
||||
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
data ParticipantEntry = ParticipantEntry
|
||||
{ peCourse :: CourseName
|
||||
, peEmail :: UserEmail
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
instance ToNamedRecord ParticipantEntry where
|
||||
toNamedRecord ParticipantEntry{..} = Csv.namedRecord
|
||||
[ "course" Csv..= peCourse
|
||||
, "email" Csv..= peEmail
|
||||
]
|
||||
|
||||
instance DefaultOrdered ParticipantEntry where
|
||||
headerOrder _ = Csv.header ["course", "email"]
|
||||
|
||||
|
||||
getParticipantsListR :: Handler Html
|
||||
getParticipantsListR = do
|
||||
schoolTerms'' <- runDB . E.select . E.from $ \(school `E.InnerJoin` term) -> do
|
||||
E.on E.true
|
||||
|
||||
E.where_ . E.exists . E.from $ \(course `E.InnerJoin` participant) -> do
|
||||
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
|
||||
E.where_ $ course E.^. CourseTerm E.==. term E.^. TermId
|
||||
E.&&. course E.^. CourseSchool E.==. school E.^. SchoolId
|
||||
|
||||
return (school E.^. SchoolId, term E.^. TermId)
|
||||
|
||||
schoolTerms' <- flip filterM schoolTerms'' $ \(E.Value ssh, E.Value tid) ->
|
||||
hasReadAccessTo $ ParticipantsR tid ssh
|
||||
|
||||
let schoolTerms :: Set (SchoolId, TermId)
|
||||
schoolTerms = setOf (folded . $(multifocusG 2) (_1 . _Value) (_2 . _Value)) schoolTerms'
|
||||
|
||||
siteLayoutMsg MsgMenuParticipantsList $ do
|
||||
setTitleI MsgMenuParticipantsList
|
||||
|
||||
let schools :: Set SchoolId
|
||||
schools = Set.map (view _1) schoolTerms
|
||||
terms :: Set TermId
|
||||
terms = Set.map (view _2) schoolTerms
|
||||
$(widgetFile "participants-list")
|
||||
|
||||
getParticipantsR :: TermId -> SchoolId -> Handler TypedContent
|
||||
getParticipantsR tid ssh = do
|
||||
csvName <- timestampCsv <*> fmap ((flip addExtension `on` unpack) extensionCsv) (getMessageRender <*> pure (MsgParticipantsCsvName tid ssh))
|
||||
setContentDisposition' $ Just csvName
|
||||
respondDefaultOrderedCsvDB $ E.selectSource partQuery .| C.map toParticipantEntry
|
||||
where
|
||||
partQuery = E.from $ \(course `E.InnerJoin` participant `E.InnerJoin` user) -> do
|
||||
E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
|
||||
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
|
||||
|
||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||
|
||||
return (course E.^. CourseName, user E.^. UserEmail)
|
||||
|
||||
toParticipantEntry (E.Value peCourse, E.Value peEmail) = ParticipantEntry{..}
|
||||
@ -892,7 +892,7 @@ correctorInvitationConfig = InvitationConfig{..}
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ (InvDBDataSheetCorrector cLoad cState, _) _ = pure $ (JunctionSheetCorrector cLoad cState, ())
|
||||
invitationInsertHook _ _ _ _ = id
|
||||
invitationInsertHook _ _ _ _ _ = id
|
||||
invitationSuccessMsg (Entity _ Sheet{..}) _ = return . SomeMessage $ MsgCorrectorInvitationAccepted sheetName
|
||||
invitationUltDest (Entity _ Sheet{..}) _ = do
|
||||
Course{..} <- get404 sheetCourse
|
||||
|
||||
@ -114,7 +114,7 @@ submissionUserInvitationConfig = InvitationConfig{..}
|
||||
return InvitationTokenConfig{..}
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ _ _ = pure (JunctionSubmissionUser, ())
|
||||
invitationInsertHook _ _ _ _ = id
|
||||
invitationInsertHook _ _ _ _ _ = id
|
||||
invitationSuccessMsg (Entity _ Submission{..}) _ = do
|
||||
Sheet{..} <- getJust submissionSheet
|
||||
return . SomeMessage $ MsgSubmissionUserInvitationAccepted sheetName
|
||||
|
||||
@ -68,7 +68,7 @@ tutorInvitationConfig = InvitationConfig{..}
|
||||
return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ _ _ = pure (JunctionTutor, ())
|
||||
invitationInsertHook _ _ _ _ = id
|
||||
invitationInsertHook _ _ _ _ _ = id
|
||||
invitationSuccessMsg (Entity _ Tutorial{..}) _ = return . SomeMessage $ MsgCorrectorInvitationAccepted tutorialName
|
||||
invitationUltDest (Entity _ Tutorial{..}) _ = do
|
||||
Course{..} <- get404 tutorialCourse
|
||||
|
||||
@ -579,7 +579,7 @@ functionInvitationConfig = InvitationConfig{..}
|
||||
return InvitationTokenConfig{..}
|
||||
invitationRestriction _ _ = return Authorized
|
||||
invitationForm _ (_, InvTokenDataUserFunction{..}) _ = pure $ (JunctionUserFunction invTokenUserFunctionFunction, ())
|
||||
invitationInsertHook _ _ _ _ = id
|
||||
invitationInsertHook _ _ _ _ _ = id
|
||||
invitationSuccessMsg (Entity _ School{..}) (Entity _ UserFunction{..}) = do
|
||||
MsgRenderer mr <- getMsgRenderer
|
||||
return . SomeMessage . MsgSchoolFunctionInvitationAccepted schoolName $ mr userFunctionFunction
|
||||
|
||||
61
src/Handler/Utils/ExamOffice/ExternalExam.hs
Normal file
61
src/Handler/Utils/ExamOffice/ExternalExam.hs
Normal file
@ -0,0 +1,61 @@
|
||||
module Handler.Utils.ExamOffice.ExternalExam
|
||||
( resultIsSynced
|
||||
, examOfficeExternalExamResultAuth
|
||||
) where
|
||||
|
||||
import Import.NoFoundation
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
|
||||
resultIsSynced :: E.SqlExpr (E.Value UserId) -- ^ office
|
||||
-> E.SqlExpr (Entity ExternalExamResult)
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
resultIsSynced authId eexamResult = (hasSchool E.&&. allSchools) E.||. (E.not_ hasSchool E.&&. anySync)
|
||||
where
|
||||
anySync = E.exists . E.from $ \synced ->
|
||||
E.where_ $ synced E.^. ExamOfficeExternalResultSyncedResult E.==. eexamResult E.^. ExternalExamResultId
|
||||
E.&&. synced E.^. ExamOfficeExternalResultSyncedTime E.>=. eexamResult E.^. ExternalExamResultLastChanged
|
||||
|
||||
hasSchool = E.exists . E.from $ \userFunction ->
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
|
||||
allSchools = E.not_ . E.exists . E.from $ \userFunction -> do
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
|
||||
E.where_ . E.not_ . E.exists . E.from $ \synced ->
|
||||
E.where_ $ synced E.^. ExamOfficeExternalResultSyncedSchool E.==. E.just (userFunction E.^. UserFunctionSchool)
|
||||
E.&&. synced E.^. ExamOfficeExternalResultSyncedResult E.==. eexamResult E.^. ExternalExamResultId
|
||||
E.&&. synced E.^. ExamOfficeExternalResultSyncedTime E.>=. eexamResult E.^. ExternalExamResultLastChanged
|
||||
|
||||
|
||||
examOfficeExternalExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office
|
||||
-> E.SqlExpr (Entity ExternalExamResult)
|
||||
-> E.SqlExpr (E.Value Bool)
|
||||
examOfficeExternalExamResultAuth authId eexamResult = authByUser E.||. authByField E.||. authBySchool E.||. authByExtraSchool
|
||||
where
|
||||
authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do
|
||||
E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField
|
||||
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. eexamResult E.^. ExternalExamResultUser
|
||||
E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId
|
||||
E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField
|
||||
E.where_ $ examOfficeField E.^. ExamOfficeFieldForced
|
||||
E.||. E.exists (E.from $ \userFunction ->
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
|
||||
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
|
||||
)
|
||||
|
||||
authByUser = E.exists . E.from $ \examOfficeUser ->
|
||||
E.where_ $ examOfficeUser E.^. ExamOfficeUserOffice E.==. authId
|
||||
E.&&. examOfficeUser E.^. ExamOfficeUserUser E.==. eexamResult E.^. ExternalExamResultUser
|
||||
|
||||
authBySchool = E.exists . E.from $ \(userFunction `E.InnerJoin` eexam) -> do
|
||||
E.on $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
|
||||
E.&&. userFunction E.^. UserFunctionSchool E.==. eexam E.^. ExternalExamSchool
|
||||
E.where_ $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
|
||||
authByExtraSchool = E.exists . E.from $ \(userFunction `E.InnerJoin` eexamSchool) -> do
|
||||
E.on $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
|
||||
E.&&. userFunction E.^. UserFunctionSchool E.==. eexamSchool E.^. ExternalExamOfficeSchoolSchool
|
||||
E.where_ $ eexamSchool E.^. ExternalExamOfficeSchoolExam E.==. eexamResult E.^. ExternalExamResultExam
|
||||
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
|
||||
476
src/Handler/Utils/ExternalExam/Users.hs
Normal file
476
src/Handler/Utils/ExternalExam/Users.hs
Normal file
@ -0,0 +1,476 @@
|
||||
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
||||
|
||||
module Handler.Utils.ExternalExam.Users where
|
||||
|
||||
import Import hiding ((.:))
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Csv
|
||||
import Handler.Utils.Users
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Colonnade
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Data.Csv ((.:))
|
||||
import qualified Data.Csv as Csv
|
||||
|
||||
import qualified Handler.Utils.ExamOffice.ExternalExam as ExternalExam
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lens as Text
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
|
||||
data ExternalExamUserMode = EEUMUsers | EEUMGrades
|
||||
deriving (Eq, Ord, Read, Show, Bounded, Enum, Generic, Typeable)
|
||||
instance Universe ExternalExamUserMode
|
||||
instance Finite ExternalExamUserMode
|
||||
nullaryPathPiece ''ExternalExamUserMode $ camelToPathPiece' 1
|
||||
|
||||
|
||||
type ExternalExamUserTableExpr = E.SqlExpr (Entity ExternalExamResult)
|
||||
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||
|
||||
type ExternalExamUserTableData = DBRow ( Entity ExternalExamResult
|
||||
, Entity User
|
||||
, Bool
|
||||
, [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
|
||||
)
|
||||
|
||||
queryUser :: Getter ExternalExamUserTableExpr (E.SqlExpr (Entity User))
|
||||
queryUser = to $(E.sqlIJproj 2 2)
|
||||
|
||||
queryResult :: Getter ExternalExamUserTableExpr (E.SqlExpr (Entity ExternalExamResult))
|
||||
queryResult = to $(E.sqlIJproj 2 1)
|
||||
|
||||
queryIsSynced :: E.SqlExpr (E.Value UserId) -> Getter ExternalExamUserTableExpr (E.SqlExpr (E.Value Bool))
|
||||
queryIsSynced authId = to $ ExternalExam.resultIsSynced authId <$> view queryResult
|
||||
|
||||
resultUser :: Lens' ExternalExamUserTableData (Entity User)
|
||||
resultUser = _dbrOutput . _2
|
||||
|
||||
resultResult :: Lens' ExternalExamUserTableData (Entity ExternalExamResult)
|
||||
resultResult = _dbrOutput . _1
|
||||
|
||||
resultIsSynced :: Lens' ExternalExamUserTableData Bool
|
||||
resultIsSynced = _dbrOutput . _3
|
||||
|
||||
resultSynchronised :: Traversal' ExternalExamUserTableData (UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)
|
||||
resultSynchronised = _dbrOutput . _4 . traverse
|
||||
|
||||
|
||||
data ExternalExamUserTableCsv = ExternalExamUserTableCsv
|
||||
{ csvEUserSurname :: Maybe Text
|
||||
, csvEUserFirstName :: Maybe Text
|
||||
, csvEUserName :: Maybe Text
|
||||
, csvEUserMatriculation :: Maybe Text
|
||||
, csvEUserOccurrenceStart :: ZonedTime
|
||||
, csvEUserExamResult :: ExamResultPassedGrade
|
||||
} deriving (Generic)
|
||||
makeLenses_ ''ExternalExamUserTableCsv
|
||||
|
||||
externalExamUserTableCsvOptions :: Csv.Options
|
||||
externalExamUserTableCsvOptions = Csv.defaultOptions { Csv.fieldLabelModifier = camelToPathPiece' 3 }
|
||||
|
||||
instance ToNamedRecord ExternalExamUserTableCsv where
|
||||
toNamedRecord = Csv.genericToNamedRecord externalExamUserTableCsvOptions
|
||||
|
||||
instance DefaultOrdered ExternalExamUserTableCsv where
|
||||
headerOrder = Csv.genericHeaderOrder externalExamUserTableCsvOptions
|
||||
|
||||
instance FromNamedRecord ExternalExamUserTableCsv where
|
||||
parseNamedRecord csv
|
||||
= ExternalExamUserTableCsv
|
||||
<$> csv .:?? "surname"
|
||||
<*> csv .:?? "first-name"
|
||||
<*> csv .:?? "name"
|
||||
<*> csv .:?? "matriculation"
|
||||
<*> csv .: "occurrence-start"
|
||||
<*> csv .: "exam-result"
|
||||
|
||||
|
||||
instance CsvColumnsExplained ExternalExamUserTableCsv where
|
||||
csvColumnsExplanations = genericCsvColumnsExplanations externalExamUserTableCsvOptions $ Map.fromList
|
||||
[ ('csvEUserSurname , MsgCsvColumnExamUserSurname )
|
||||
, ('csvEUserFirstName , MsgCsvColumnExamUserFirstName )
|
||||
, ('csvEUserName , MsgCsvColumnExamUserName )
|
||||
, ('csvEUserMatriculation , MsgCsvColumnExamUserMatriculation )
|
||||
, ('csvEUserOccurrenceStart , MsgCsvColumnExamOfficeExamUserOccurrenceStart )
|
||||
, ('csvEUserExamResult , MsgCsvColumnExamUserResult )
|
||||
]
|
||||
|
||||
data ExternalExamUserAction
|
||||
= ExternalExamUserMarkSynchronised
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ExternalExamUserAction
|
||||
instance Finite ExternalExamUserAction
|
||||
nullaryPathPiece ''ExternalExamUserAction $ camelToPathPiece' 3
|
||||
embedRenderMessage ''UniWorX ''ExternalExamUserAction id
|
||||
|
||||
data ExternalExamUserActionData
|
||||
= ExternalExamUserMarkSynchronisedData
|
||||
|
||||
newtype ExternalExamUserCsvExportDataGrades = ExternalExamUserCsvExportDataGrades
|
||||
{ csvEEUserMarkSynchronised :: Bool
|
||||
} deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
|
||||
data ExamUserCsvException
|
||||
= ExamUserCsvExceptionNoMatchingUser
|
||||
deriving (Show, Generic, Typeable)
|
||||
|
||||
instance Exception ExamUserCsvException
|
||||
|
||||
embedRenderMessage ''UniWorX ''ExamUserCsvException id
|
||||
|
||||
|
||||
data ExternalExamUserCsvActionClass
|
||||
= ExternalExamUserCsvRegister
|
||||
| ExternalExamUserCsvDeregister
|
||||
| ExternalExamUserCsvSetTime
|
||||
| ExternalExamUserCsvSetResult
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
embedRenderMessage ''UniWorX ''ExternalExamUserCsvActionClass id
|
||||
|
||||
data ExternalExamUserCsvAction
|
||||
= ExternalExamUserCsvRegisterData
|
||||
{ externalExamUserCsvActUser :: UserId
|
||||
, externalExamUserCsvActTime :: UTCTime
|
||||
, externalExamUserCsvActResult :: ExamResultPassedGrade
|
||||
}
|
||||
| ExternalExamUserCsvSetTimeData
|
||||
{ externalExamUserCsvActRegistration :: ExternalExamResultId
|
||||
, externalExamUserCsvActTime :: UTCTime
|
||||
}
|
||||
| ExternalExamUserCsvSetResultData
|
||||
{ externalExamUserCsvActRegistration :: ExternalExamResultId
|
||||
, externalExamUserCsvActResult :: ExamResultPassedGrade
|
||||
}
|
||||
| ExternalExamUserCsvDeregisterData
|
||||
{ externalExamUserCsvActRegistration :: ExternalExamResultId
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
deriveJSON defaultOptions
|
||||
{ constructorTagModifier = over Text.packed $ Text.intercalate "-" . map Text.toLower . drop 4 . dropEnd 1 . splitCamel
|
||||
, fieldLabelModifier = camelToPathPiece' 5
|
||||
, sumEncoding = TaggedObject "action" "data"
|
||||
} ''ExternalExamUserCsvAction
|
||||
|
||||
|
||||
makeExternalExamUsersTable :: ExternalExamUserMode
|
||||
-> Entity ExternalExam
|
||||
-> DB (FormResult (ExternalExamUserActionData, Set ExternalExamResultId), Widget)
|
||||
makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do
|
||||
let tid = externalExamTerm
|
||||
ssh = externalExamSchool
|
||||
coursen = externalExamCourseName
|
||||
examn = externalExamExamName
|
||||
|
||||
uid <- requireAuthId
|
||||
csvName <- getMessageRender <*> pure (MsgExternalExamUserCsvName tid ssh coursen examn)
|
||||
isLecturer <- hasReadAccessTo $ EExamR tid ssh coursen examn EEUsersR
|
||||
currentRoute <- fromMaybe (error "makeExternalExamUsersTable called from 404-handler") <$> getCurrentRoute
|
||||
|
||||
let
|
||||
resultView :: ExamResultGrade -> ExamResultPassedGrade
|
||||
resultView = fmap $ bool (Left . view passingGrade) Right externalExamShowGrades
|
||||
|
||||
dbtSQLQuery = runReaderT $ do
|
||||
result <- view queryResult
|
||||
user <- view queryUser
|
||||
isSynced <- view . queryIsSynced $ E.val uid
|
||||
|
||||
lift $ do
|
||||
E.on $ result E.^. ExternalExamResultUser E.==. user E.^. UserId
|
||||
|
||||
E.where_ $ result E.^. ExternalExamResultExam E.==. E.val eeId
|
||||
|
||||
unless (isLecturer || mode == EEUMUsers) $
|
||||
E.where_ $ ExternalExam.examOfficeExternalExamResultAuth (E.val uid) result
|
||||
|
||||
return (result, user, isSynced)
|
||||
dbtRowKey = views queryResult (E.^. ExternalExamResultId)
|
||||
|
||||
dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) ExternalExamUserTableData
|
||||
dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $
|
||||
(,,,)
|
||||
<$> view _1 <*> view _2 <*> view (_3 . _Value)
|
||||
<*> getSynchronised
|
||||
where
|
||||
getSynchronised :: ReaderT _ (MaybeT (YesodDB UniWorX)) [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
|
||||
getSynchronised = do
|
||||
resId <- view $ _1 . _entityKey
|
||||
syncs <- lift . lift . E.select . E.from $ \(examOfficeExternalResultSynced `E.InnerJoin` user) -> do
|
||||
E.on $ examOfficeExternalResultSynced E.^. ExamOfficeExternalResultSyncedOffice E.==. user E.^. UserId
|
||||
E.where_ $ examOfficeExternalResultSynced E.^. ExamOfficeExternalResultSyncedResult E.==. E.val resId
|
||||
return ( examOfficeExternalResultSynced E.^. ExamOfficeExternalResultSyncedOffice
|
||||
, ( user E.^. UserDisplayName
|
||||
, user E.^. UserSurname
|
||||
, examOfficeExternalResultSynced E.^. ExamOfficeExternalResultSyncedTime
|
||||
, examOfficeExternalResultSynced E.^. ExamOfficeExternalResultSyncedSchool
|
||||
)
|
||||
)
|
||||
let syncs' = Map.fromListWith
|
||||
(\(dn, sn, t, sshs) (_, _, _, sshs') -> (dn, sn, t, Set.union sshs sshs'))
|
||||
[ ((officeId, t), (dn, sn, t, maybe Set.empty Set.singleton ssh'))
|
||||
| (E.Value officeId, (E.Value dn, E.Value sn, E.Value t, fmap unSchoolKey . E.unValue -> ssh')) <- syncs
|
||||
]
|
||||
return $ Map.elems syncs'
|
||||
|
||||
colSynced = Colonnade.singleton (fromSortable . Sortable (Just "is-synced") $ i18nCell MsgExamUserSynchronised) $ \x -> cell . flip runReaderT x $ do
|
||||
syncs <- asks $ sortOn (Down . view _3) . toListOf resultSynchronised
|
||||
lastChange <- view $ resultResult . _entityVal . _externalExamResultLastChanged
|
||||
user <- view $ resultUser . _entityVal
|
||||
isSynced <- view resultIsSynced
|
||||
let
|
||||
hasSyncs = has folded syncs
|
||||
|
||||
syncs' = [ Right sync | sync@(_, _, t, _) <- syncs, t > lastChange]
|
||||
++ [ Left lastChange ]
|
||||
++ [ Right sync | sync@(_, _, t, _) <- syncs, t <= lastChange]
|
||||
|
||||
syncIcon :: Widget
|
||||
syncIcon
|
||||
| not isSynced
|
||||
, not hasSyncs
|
||||
= mempty
|
||||
| not isSynced
|
||||
= toWidget iconNotOK
|
||||
| otherwise
|
||||
= toWidget iconOK
|
||||
|
||||
syncsModal :: Widget
|
||||
syncsModal = $(widgetFile "exam-office/exam-result-synced")
|
||||
lift $ bool id (flip modal $ Right syncsModal) hasSyncs syncIcon
|
||||
|
||||
dbtColonnade :: Colonnade Sortable _ _
|
||||
dbtColonnade = mconcat
|
||||
[ case mode of
|
||||
EEUMGrades -> mconcat
|
||||
[ dbSelect (applying _2) id $ return . view (resultResult . _entityKey)
|
||||
, colSynced
|
||||
]
|
||||
_other -> mempty
|
||||
, colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
|
||||
, colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
|
||||
, Colonnade.singleton (fromSortable . Sortable (Just "occurrence-start") $ i18nCell MsgExamTime) $ \x -> cell . flip runReaderT x $ do
|
||||
t <- view $ resultResult . _entityVal . _externalExamResultTime
|
||||
lift $ formatTimeW SelFormatDateTime t
|
||||
, colExamResult externalExamShowGrades (resultResult . _entityVal . _externalExamResultResult)
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ sortUserName' (queryUser . to ((,) <$> (E.^. UserDisplayName) <*> (E.^. UserSurname)))
|
||||
, sortUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
|
||||
, sortOccurrenceStart (queryResult . to (E.^. ExternalExamResultTime))
|
||||
, maybeOpticSortColumn (sortExamResult externalExamShowGrades) (queryResult . to (E.^. ExternalExamResultResult))
|
||||
, singletonMap "is-synced" . SortColumn $ view (queryIsSynced $ E.val uid)
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ fltrUserName' (queryUser . to (E.^. UserDisplayName))
|
||||
, fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
|
||||
, fltrExamResultPoints externalExamShowGrades (queryResult . to (E.^. ExternalExamResultResult))
|
||||
, singletonMap "is-synced" . FilterColumn $ E.mkExactFilter (view . queryIsSynced $ E.val uid)
|
||||
]
|
||||
dbtFilterUI = mconcat
|
||||
[ fltrUserNameUI'
|
||||
, fltrUserMatriculationUI
|
||||
, fltrExamResultPointsUI externalExamShowGrades
|
||||
, case mode of
|
||||
EEUMGrades ->
|
||||
\mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamUserSynchronised)
|
||||
_other -> mempty
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Just $ SomeRoute currentRoute
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = case mode of
|
||||
EEUMGrades -> FormSubmit
|
||||
_other -> FormNoSubmit
|
||||
, dbParamsFormAdditional = case mode of
|
||||
EEUMGrades -> \csrf -> do
|
||||
let
|
||||
actionMap :: Map ExternalExamUserAction (AForm Handler ExternalExamUserActionData)
|
||||
actionMap = Map.fromList
|
||||
[ ( ExternalExamUserMarkSynchronised
|
||||
, pure ExternalExamUserMarkSynchronisedData
|
||||
)
|
||||
]
|
||||
(res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
|
||||
let formRes = (, mempty) . First . Just <$> res
|
||||
return (formRes, formWgt)
|
||||
_other -> \csrf -> return (FormMissing, toWidget csrf)
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
dbtIdent = mode
|
||||
dbtCsvEncode = case mode of
|
||||
EEUMGrades -> Just DBTCsvEncode
|
||||
{ dbtCsvExportForm = ExternalExamUserCsvExportDataGrades
|
||||
<$> apopt checkBoxField (fslI MsgExamUserMarkSynchronisedCsv & setTooltip MsgExamUserMarkSynchronisedCsvTip) (Just False)
|
||||
, dbtCsvDoEncode = \ExternalExamUserCsvExportDataGrades{..} -> C.mapM $ \(E.Value k, row) -> do
|
||||
when csvEEUserMarkSynchronised $ externalExamResultMarkSynchronised k
|
||||
return $ encodeCsv' row
|
||||
, dbtCsvName = unpack csvName
|
||||
, dbtCsvNoExportData = Nothing
|
||||
, dbtCsvHeader = const . return $ headerOrder (error "headerOrder" :: ExternalExamUserTableCsv)
|
||||
}
|
||||
EEUMUsers -> simpleCsvEncode csvName encodeCsv'
|
||||
where
|
||||
encodeCsv' :: ExternalExamUserTableData -> ExternalExamUserTableCsv
|
||||
encodeCsv' row = ExternalExamUserTableCsv
|
||||
{ csvEUserSurname = row ^? resultUser . _entityVal . _userSurname
|
||||
, csvEUserFirstName = row ^? resultUser . _entityVal . _userFirstName
|
||||
, csvEUserName = row ^? resultUser . _entityVal . _userDisplayName
|
||||
, csvEUserMatriculation = row ^? resultUser . _entityVal . _userMatrikelnummer . _Just
|
||||
, csvEUserOccurrenceStart = row ^. resultResult . _entityVal . _externalExamResultTime . to utcToZonedTime
|
||||
, csvEUserExamResult = row ^. resultResult . _entityVal . _externalExamResultResult . to (fmap $ bool (Left . view passingGrade) Right externalExamShowGrades)
|
||||
}
|
||||
dbtCsvDecode
|
||||
| mode == EEUMUsers = Just DBTCsvDecode
|
||||
{ dbtCsvRowKey = \csv -> do
|
||||
pid <- lift $ guessUser' csv
|
||||
fmap E.Value . MaybeT . getKeyBy $ UniqueExternalExamResult eeId pid
|
||||
, dbtCsvComputeActions = \case
|
||||
DBCsvDiffMissing{dbCsvOldKey}
|
||||
-> yield . ExternalExamUserCsvDeregisterData $ E.unValue dbCsvOldKey
|
||||
DBCsvDiffNew{dbCsvNewKey = Just _}
|
||||
-> error "An UniqueExternalExamResult could be found, but the ExternalExamResultKey is not among the existing keys"
|
||||
DBCsvDiffNew{dbCsvNewKey = Nothing, dbCsvNew} -> do
|
||||
pid <- lift $ guessUser' dbCsvNew
|
||||
let ExternalExamUserTableCsv{..} = dbCsvNew
|
||||
yield $ ExternalExamUserCsvRegisterData pid (zonedTimeToUTC csvEUserOccurrenceStart) csvEUserExamResult
|
||||
DBCsvDiffExisting{..} -> do
|
||||
let ExternalExamUserTableCsv{..} = dbCsvNew
|
||||
when (zonedTimeToUTC csvEUserOccurrenceStart /= dbCsvOld ^. resultResult . _entityVal . _externalExamResultTime) $
|
||||
yield $ ExternalExamUserCsvSetTimeData (E.unValue dbCsvOldKey) (zonedTimeToUTC csvEUserOccurrenceStart)
|
||||
|
||||
when (csvEUserExamResult /= dbCsvOld ^. resultResult . _entityVal . _externalExamResultResult . to resultView) $
|
||||
yield $ ExternalExamUserCsvSetResultData (E.unValue dbCsvOldKey) csvEUserExamResult
|
||||
, dbtCsvClassifyAction = \case
|
||||
ExternalExamUserCsvRegisterData{} -> ExternalExamUserCsvRegister
|
||||
ExternalExamUserCsvSetTimeData{} -> ExternalExamUserCsvSetTime
|
||||
ExternalExamUserCsvSetResultData{} -> ExternalExamUserCsvSetResult
|
||||
ExternalExamUserCsvDeregisterData{} -> ExternalExamUserCsvDeregister
|
||||
, dbtCsvCoarsenActionClass = \case
|
||||
ExternalExamUserCsvRegister -> DBCsvActionNew
|
||||
ExternalExamUserCsvDeregister -> DBCsvActionMissing
|
||||
_other -> DBCsvActionExisting
|
||||
, dbtCsvExecuteActions = do
|
||||
C.mapM_ $ \case
|
||||
ExternalExamUserCsvRegisterData{..} -> do
|
||||
now <- liftIO getCurrentTime
|
||||
let res' = either (review passingGrade) id <$> externalExamUserCsvActResult
|
||||
insert_ ExternalExamResult
|
||||
{ externalExamResultExam = eeId
|
||||
, externalExamResultUser = externalExamUserCsvActUser
|
||||
, externalExamResultTime = externalExamUserCsvActTime
|
||||
, externalExamResultResult = res'
|
||||
, externalExamResultLastChanged = now
|
||||
}
|
||||
audit $ TransactionExternalExamResultEdit eeId externalExamUserCsvActUser
|
||||
ExternalExamUserCsvSetTimeData{..} -> do
|
||||
now <- liftIO getCurrentTime
|
||||
ExternalExamResult{..} <- updateGet externalExamUserCsvActRegistration
|
||||
[ ExternalExamResultTime =. externalExamUserCsvActTime
|
||||
, ExternalExamResultLastChanged =. now
|
||||
]
|
||||
audit $ TransactionExternalExamResultEdit eeId externalExamResultUser
|
||||
ExternalExamUserCsvSetResultData{..} -> do
|
||||
now <- liftIO getCurrentTime
|
||||
let res' = either (review passingGrade) id <$> externalExamUserCsvActResult
|
||||
ExternalExamResult{..} <- updateGet externalExamUserCsvActRegistration
|
||||
[ ExternalExamResultResult =. res'
|
||||
, ExternalExamResultLastChanged =. now
|
||||
]
|
||||
audit $ TransactionExternalExamResultEdit eeId externalExamResultUser
|
||||
ExternalExamUserCsvDeregisterData{..} -> do
|
||||
ExternalExamResult{..} <- getJust externalExamUserCsvActRegistration
|
||||
delete externalExamUserCsvActRegistration
|
||||
audit $ TransactionExternalExamResultDelete eeId externalExamResultUser
|
||||
return $ EExamR tid ssh coursen examn EEUsersR
|
||||
, dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case
|
||||
ExternalExamUserCsvRegisterData{..} -> do
|
||||
User{..} <- liftHandler . runDB $ getJust externalExamUserCsvActUser
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{nameWidget userDisplayName userSurname}
|
||||
, ^{formatTimeW SelFormatDateTime externalExamUserCsvActTime}
|
||||
, _{externalExamUserCsvActResult}
|
||||
|]
|
||||
ExternalExamUserCsvSetTimeData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{registeredUserName' externalExamUserCsvActRegistration}
|
||||
, ^{formatTimeW SelFormatDateTime externalExamUserCsvActTime}
|
||||
|]
|
||||
ExternalExamUserCsvSetResultData{..} ->
|
||||
[whamlet|
|
||||
$newline never
|
||||
^{registeredUserName' externalExamUserCsvActRegistration}
|
||||
, _{externalExamUserCsvActResult}
|
||||
|]
|
||||
ExternalExamUserCsvDeregisterData{..} ->
|
||||
registeredUserName' externalExamUserCsvActRegistration
|
||||
, dbtCsvRenderActionClass = i18n
|
||||
, dbtCsvRenderException = ap getMessageRender . pure :: ExamUserCsvException -> DB Text
|
||||
}
|
||||
| otherwise = Nothing
|
||||
where
|
||||
registeredUserName :: Map (E.Value ExternalExamResultId) ExternalExamUserTableData -> ExternalExamResultId -> Widget
|
||||
registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname
|
||||
where
|
||||
Entity _ User{..} = view resultUser $ existing Map.! registration
|
||||
|
||||
guessUser' :: ExternalExamUserTableCsv -> DB UserId
|
||||
guessUser' ExternalExamUserTableCsv{..} = do
|
||||
let criteria = Set.fromList $ catMaybes
|
||||
[ GuessUserMatrikelnummer <$> csvEUserMatriculation
|
||||
, GuessUserDisplayName <$> csvEUserName
|
||||
, GuessUserSurname <$> csvEUserSurname
|
||||
, GuessUserFirstName <$> csvEUserFirstName
|
||||
]
|
||||
maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria
|
||||
externalExamUsersDBTableValidator = def
|
||||
& defaultSorting (bool id (SortAscBy "is-synced" :) (mode == EEUMGrades) [SortAscBy "user-name"])
|
||||
& defaultPagesize PagesizeAll
|
||||
|
||||
postprocess :: FormResult (First ExternalExamUserActionData, DBFormResult ExternalExamResultId Bool ExternalExamUserTableData) -> FormResult (ExternalExamUserActionData, Set ExternalExamResultId)
|
||||
postprocess inp = do
|
||||
(First (Just act), regMap) <- inp
|
||||
let regSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) regMap
|
||||
return (act, regSet)
|
||||
|
||||
over _1 postprocess <$> dbTable externalExamUsersDBTableValidator DBTable{..}
|
||||
|
||||
externalExamResultMarkSynchronised :: ExternalExamResultId -> DB ()
|
||||
externalExamResultMarkSynchronised resId = do
|
||||
uid <- requireAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
userFunctions <- selectList [ UserFunctionUser ==. uid, UserFunctionFunction ==. SchoolExamOffice ] []
|
||||
if
|
||||
| null userFunctions ->
|
||||
insert_ ExamOfficeExternalResultSynced
|
||||
{ examOfficeExternalResultSyncedOffice = uid
|
||||
, examOfficeExternalResultSyncedResult = resId
|
||||
, examOfficeExternalResultSyncedTime = now
|
||||
, examOfficeExternalResultSyncedSchool = Nothing
|
||||
}
|
||||
| otherwise ->
|
||||
insertMany_ [ ExamOfficeExternalResultSynced
|
||||
{ examOfficeExternalResultSyncedOffice = uid
|
||||
, examOfficeExternalResultSyncedResult = resId
|
||||
, examOfficeExternalResultSyncedTime = now
|
||||
, examOfficeExternalResultSyncedSchool = Just userFunctionSchool
|
||||
}
|
||||
| Entity _ UserFunction{..} <- userFunctions
|
||||
]
|
||||
@ -134,7 +134,7 @@ data InvitationConfig junction = forall formCtx. InvitationConfig
|
||||
-- ^ Additional restrictions to check before allowing an user to redeem an invitation token
|
||||
, invitationForm :: Entity (InvitationFor junction) -> InvitationData junction -> Key User -> AForm (YesodDB UniWorX) (InvitableJunction junction, formCtx)
|
||||
-- ^ Assimilate the additional data entered by the redeeming user
|
||||
, invitationInsertHook :: forall a. Entity (InvitationFor junction) -> InvitationData junction -> junction -> formCtx -> (YesodJobDB UniWorX a -> YesodJobDB UniWorX a)
|
||||
, invitationInsertHook :: forall a. UserEmail -> Entity (InvitationFor junction) -> InvitationData junction -> junction -> formCtx -> (YesodJobDB UniWorX a -> YesodJobDB UniWorX a)
|
||||
-- ^ Perform additional actions before or after insertion of the junction into the database
|
||||
, invitationSuccessMsg :: Entity (InvitationFor junction) -> Entity junction -> DB (SomeMessage UniWorX)
|
||||
-- ^ What to tell the redeeming user after accepting the invitation
|
||||
@ -402,7 +402,7 @@ invitationR' InvitationConfig{..} = liftHandler $ do
|
||||
return . Just $ SomeRoute HomeR
|
||||
Just (jData, formCtx) -> do
|
||||
let junction = review _InvitableJunction (invitee, fid, jData)
|
||||
mResult <- invitationInsertHook fEnt iData junction formCtx $ insertUniqueEntity junction
|
||||
mResult <- invitationInsertHook itEmail fEnt iData junction formCtx $ insertUniqueEntity junction
|
||||
case mResult of
|
||||
Nothing -> invalidArgsI [MsgInvitationCollision]
|
||||
Just res -> do
|
||||
|
||||
@ -840,6 +840,31 @@ anchorColonnadeM mkUrl = imapColonnade anchorColonnade'
|
||||
anchorColonnade' inp (view dbCell -> (attrs, act)) = review dbCell . (attrs,) $
|
||||
view (dbCell . _2) . anchorCellM (mkUrl inp) =<< act
|
||||
|
||||
maybeAnchorColonnade :: forall h r' m a url.
|
||||
( HasRoute UniWorX url
|
||||
, IsDBTable m a
|
||||
, HandlerSite m ~ UniWorX
|
||||
)
|
||||
=> (r' -> Maybe url)
|
||||
-> Colonnade h r' (DBCell m a)
|
||||
-> Colonnade h r' (DBCell m a)
|
||||
maybeAnchorColonnade = maybeAnchorColonnadeM . (hoistMaybe .)
|
||||
|
||||
maybeAnchorColonnadeM :: forall h r' m a url.
|
||||
( HasRoute UniWorX url
|
||||
, IsDBTable m a
|
||||
, HandlerSite m ~ UniWorX
|
||||
)
|
||||
=> (r' -> MaybeT (WidgetFor UniWorX) url)
|
||||
-> Colonnade h r' (DBCell m a)
|
||||
-> Colonnade h r' (DBCell m a)
|
||||
maybeAnchorColonnadeM mkUrl = imapColonnade anchorColonnade'
|
||||
where
|
||||
anchorColonnade' :: r' -> DBCell m a -> DBCell m a
|
||||
anchorColonnade' inp (view dbCell -> (attrs, act)) = review dbCell . (attrs,) $
|
||||
view (dbCell . _2) . maybeAnchorCellM (mkUrl inp) =<< act
|
||||
|
||||
|
||||
emptyOpticColonnade :: forall h r' focus c.
|
||||
( Monoid c
|
||||
)
|
||||
|
||||
@ -33,6 +33,7 @@ module Handler.Utils.Table.Pagination
|
||||
, cell, textCell, stringCell, i18nCell
|
||||
, anchorCell, anchorCell', anchorCellM, anchorCellM'
|
||||
, linkEitherCell, linkEitherCellM, linkEitherCellM'
|
||||
, maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
|
||||
, cellTooltip
|
||||
, listCell
|
||||
, formCell, DBFormResult(..), getDBFormResult
|
||||
@ -93,6 +94,8 @@ import Data.Ratio ((%))
|
||||
|
||||
import Data.List (elemIndex)
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
import Data.Aeson (Options(..), SumEncoding(..), defaultOptions)
|
||||
import Data.Aeson.Text
|
||||
import Data.Aeson.TH (deriveJSON)
|
||||
@ -1300,6 +1303,12 @@ anchorCellM routeM widget = anchorCellM' routeM id (const widget)
|
||||
anchorCellM' :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => WidgetFor UniWorX x -> (x -> url) -> (x -> wgt) -> DBCell m a
|
||||
anchorCellM' xM x2route x2widget = linkEitherCellM' xM x2route (x2widget, x2widget)
|
||||
|
||||
maybeAnchorCellM :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => MaybeT (WidgetFor UniWorX) url -> wgt -> DBCell m a
|
||||
maybeAnchorCellM routeM widget = maybeAnchorCellM' routeM id (const widget)
|
||||
|
||||
maybeAnchorCellM' :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => MaybeT (WidgetFor UniWorX) x -> (x -> url) -> (Maybe x -> wgt) -> DBCell m a
|
||||
maybeAnchorCellM' xM x2route x2widget = maybeLinkEitherCellM' xM x2route (x2widget . Just, x2widget)
|
||||
|
||||
-- | Variant of `anchorCell` that displays different widgets depending whether the route is authorized for current user
|
||||
linkEitherCell :: (HasRoute UniWorX url, ToWidget UniWorX wgt, ToWidget UniWorX wgt', IsDBTable m a) => url -> (wgt, wgt') -> DBCell m a
|
||||
linkEitherCell = linkEitherCellM . return
|
||||
@ -1314,17 +1323,31 @@ linkEitherCellM' :: forall m url wgt wgt' a x.
|
||||
, IsDBTable m a
|
||||
)
|
||||
=> WidgetFor UniWorX x -> (x -> url) -> (x -> wgt, x -> wgt') -> DBCell m a
|
||||
linkEitherCellM' xM x2route (x2widgetAuth,x2widgetUnauth) = cell $ do
|
||||
x <- xM
|
||||
let route = x2route x
|
||||
widget, widgetUnauth :: Widget
|
||||
widget = toWidget $ x2widgetAuth x
|
||||
widgetUnauth = toWidget $ x2widgetUnauth x
|
||||
authResult <- liftHandler $ isAuthorized (urlRoute route) False
|
||||
linkUrl <- toTextUrl route
|
||||
case authResult of
|
||||
Authorized -> $(widgetFile "table/cell/link") -- show allowed link
|
||||
_otherwise -> widgetUnauth -- show alternative widget
|
||||
linkEitherCellM' xM x2route (x2widgetAuth,x2widgetUnauth) = maybeLinkEitherCellM' (lift xM) x2route (x2widgetAuth, x2widgetUnauth . fromJust)
|
||||
|
||||
maybeLinkEitherCellM' :: forall m url wgt wgt' a x.
|
||||
( HasRoute UniWorX url
|
||||
, ToWidget UniWorX wgt
|
||||
, ToWidget UniWorX wgt'
|
||||
, IsDBTable m a
|
||||
)
|
||||
=> MaybeT (WidgetFor UniWorX) x -> (x -> url) -> (x -> wgt, Maybe x -> wgt') -> DBCell m a
|
||||
maybeLinkEitherCellM' xM x2route (x2widgetAuth,x2widgetUnauth) = cell $ do
|
||||
x' <- runMaybeT xM
|
||||
case x' of
|
||||
Just x -> do
|
||||
let route = x2route x
|
||||
widget, widgetUnauth :: Widget
|
||||
widget = toWidget $ x2widgetAuth x
|
||||
widgetUnauth = toWidget . x2widgetUnauth $ Just x
|
||||
authResult <- liftHandler $ isAuthorized (urlRoute route) False
|
||||
linkUrl <- toTextUrl route
|
||||
case authResult of
|
||||
Authorized -> $(widgetFile "table/cell/link") -- show allowed link
|
||||
_otherwise -> widgetUnauth -- show alternative widget
|
||||
_otherwise -> do
|
||||
toWidget $ x2widgetUnauth Nothing
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -2,9 +2,12 @@ module Handler.Utils.Users
|
||||
( computeUserAuthenticationDigest
|
||||
, Digest, SHA3_256
|
||||
, constEq
|
||||
, GuessUserInfo(..)
|
||||
, guessUser
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Auth.LDAP (campusUserMatr')
|
||||
|
||||
import Crypto.Hash (Digest, SHA3_256, hashlazy)
|
||||
|
||||
@ -12,6 +15,74 @@ import Data.ByteArray (constEq)
|
||||
|
||||
import qualified Data.Aeson as JSON
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
|
||||
computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256
|
||||
computeUserAuthenticationDigest = hashlazy . JSON.encode
|
||||
|
||||
|
||||
data GuessUserInfo
|
||||
= GuessUserMatrikelnummer { guessUserMatrikelnummer :: UserMatriculation }
|
||||
| GuessUserDisplayName { guessUserDisplayName :: UserDisplayName }
|
||||
| GuessUserSurname { guessUserSurname :: UserSurname }
|
||||
| GuessUserFirstName { guessUserFirstName :: UserFirstName }
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
instance Binary GuessUserInfo
|
||||
|
||||
makeLenses_ ''GuessUserInfo
|
||||
|
||||
guessUser :: Set GuessUserInfo -> DB (Maybe UserId)
|
||||
guessUser (Set.toList -> criteria) = $cachedHereBinary criteria $ go False
|
||||
where
|
||||
toSql user = \case
|
||||
GuessUserMatrikelnummer userMatriculation' -> user E.^. UserMatrikelnummer E.==. E.val (Just userMatriculation')
|
||||
GuessUserDisplayName userDisplayName' -> user E.^. UserDisplayName `E.hasInfix` E.val userDisplayName'
|
||||
GuessUserSurname userSurname' -> user E.^. UserSurname `E.hasInfix` E.val userSurname'
|
||||
GuessUserFirstName userFirstName' -> user E.^. UserFirstName `E.hasInfix` E.val userFirstName'
|
||||
|
||||
go didLdap = do
|
||||
let retrieveUsers = E.select . E.from $ \user -> do
|
||||
E.where_ . E.and $ map (toSql user) criteria
|
||||
return user
|
||||
users <- retrieveUsers
|
||||
let users' = sortBy (flip closeness) users
|
||||
|
||||
matchesMatriculation :: Entity User -> Maybe Bool
|
||||
matchesMatriculation = preview $ _entityVal . _userMatrikelnummer . to (\userMatr -> all ((== userMatr) . Just) $ criteria ^.. folded . _guessUserMatrikelnummer)
|
||||
|
||||
closeness :: Entity User -> Entity User -> Ordering
|
||||
closeness = mconcat $ concat
|
||||
[ pure $ comparing (fmap Down . matchesMatriculation)
|
||||
, (criteria ^.. folded . _guessUserSurname) <&> \surn -> comparing (preview $ _entityVal . _userSurname . to CI.mk . only (CI.mk surn))
|
||||
, (criteria ^.. folded . _guessUserFirstName) <&> \firstn -> comparing (preview $ _entityVal . _userFirstName . to CI.mk . only (CI.mk firstn))
|
||||
, (criteria ^.. folded . _guessUserDisplayName) <&> \dispn -> comparing (preview $ _entityVal . _userDisplayName . to CI.mk . only (CI.mk dispn))
|
||||
]
|
||||
|
||||
doLdap userMatr = do
|
||||
app <- getYesod
|
||||
let ldap = (,) <$> app ^. _appLdapConf <*> app ^. _appLdapPool
|
||||
fmap (fmap entityKey . join) . for ldap $ \(ldapConf, ldapPool) -> do
|
||||
ldapData <- campusUserMatr' ldapConf ldapPool userMatr
|
||||
for ldapData $ upsertCampusUser UpsertCampusUser
|
||||
|
||||
|
||||
case users' of
|
||||
x@(Entity pid _) : xs
|
||||
| [] <- xs
|
||||
, fromMaybe False (matchesMatriculation x) || didLdap
|
||||
-> return $ Just pid
|
||||
| x' : _ <- xs
|
||||
, fromMaybe False (matchesMatriculation x) || didLdap
|
||||
, GT <- x `closeness` x'
|
||||
-> return $ Just pid
|
||||
| not didLdap
|
||||
, userMatr : userMatrs' <- criteria ^.. folded . _guessUserMatrikelnummer
|
||||
, all (== userMatr) userMatrs'
|
||||
-> doLdap userMatr >>= maybe (go True) (return . Just)
|
||||
_other
|
||||
-> return Nothing
|
||||
|
||||
@ -307,6 +307,27 @@ determineCrontab = execWriterT $ do
|
||||
|
||||
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ examJobs
|
||||
|
||||
|
||||
let
|
||||
externalExamJobs (Entity nExternalExam ExternalExam{..}) = do
|
||||
newestResult <- lift . E.select . E.from $ \externalExamResult -> do
|
||||
E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val nExternalExam
|
||||
return . E.max_ $ externalExamResult E.^. ExternalExamResultLastChanged
|
||||
|
||||
case newestResult of
|
||||
[E.Value (Just lastChange)] ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationExamOfficeExternalExamResults{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ addUTCTime appNotificationCollateDelay lastChange
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = nominalDay
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
}
|
||||
_other -> return ()
|
||||
|
||||
runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ externalExamJobs
|
||||
|
||||
let
|
||||
allocationJobs (Entity nAllocation Allocation{..}) = do
|
||||
whenIsJust allocationStaffRegisterFrom $ \staffRegisterFrom ->
|
||||
|
||||
@ -16,6 +16,7 @@ import Jobs.Queue
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Handler.Utils.ExamOffice.Exam
|
||||
import Handler.Utils.ExamOffice.ExternalExam
|
||||
|
||||
|
||||
dispatchJobQueueNotification :: Notification -> Handler ()
|
||||
@ -198,6 +199,12 @@ determineNotificationCandidates NotificationExamOfficeExamResultsChanged{..} =
|
||||
E.where_ $ examResult E.^. ExamResultId `E.in_` E.valList (Set.toList nExamResults)
|
||||
E.where_ $ examOfficeExamResultAuth (user E.^. UserId) examResult
|
||||
return user
|
||||
determineNotificationCandidates NotificationExamOfficeExternalExamResults{..} =
|
||||
E.select . E.from $ \user -> do
|
||||
E.where_ . E.exists . E.from $ \externalExamResult -> do
|
||||
E.where_ $ externalExamResult E.^. ExternalExamResultExam E.==. E.val nExternalExam
|
||||
E.where_ $ examOfficeExternalExamResultAuth (user E.^. UserId) externalExamResult
|
||||
return user
|
||||
determineNotificationCandidates notif@NotificationAllocationResults{..} = do
|
||||
lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
||||
E.select . E.from $ \user -> do
|
||||
@ -261,6 +268,7 @@ classifyNotification NotificationAllocationOutdatedRatings{} = return NTAll
|
||||
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
|
||||
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
|
||||
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
|
||||
classifyNotification NotificationExamOfficeExternalExamResults{} = return NTExamOfficeExamResults
|
||||
classifyNotification NotificationAllocationResults{} = return NTAllocationResults
|
||||
classifyNotification NotificationCourseRegistered{} = return NTCourseRegistered
|
||||
classifyNotification NotificationSubmissionEdited{} = return NTSubmissionEdited
|
||||
|
||||
@ -3,6 +3,7 @@
|
||||
module Jobs.Handler.SendNotification.ExamOffice
|
||||
( dispatchNotificationExamOfficeExamResults
|
||||
, dispatchNotificationExamOfficeExamResultsChanged
|
||||
, dispatchNotificationExamOfficeExternalExamResults
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -61,3 +62,22 @@ dispatchNotificationExamOfficeExamResultsChanged nExamResults jRecipient = do
|
||||
|
||||
addAlternatives $
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/examResultsChanged.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
|
||||
|
||||
dispatchNotificationExamOfficeExternalExamResults :: ExternalExamId -> UserId -> Handler ()
|
||||
dispatchNotificationExamOfficeExternalExamResults nExternalExam jRecipient = userMailT jRecipient $ do
|
||||
ExternalExam{..} <- liftHandler . runDB $ getJust nExternalExam
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectExamOfficeExternalExamResults externalExamCourseName externalExamExamName
|
||||
|
||||
MsgRenderer mr <- getMailMsgRenderer
|
||||
let termDesc = mr . ShortTermIdentifier $ unTermKey externalExamTerm
|
||||
tid = externalExamTerm
|
||||
ssh = externalExamSchool
|
||||
coursen = externalExamCourseName
|
||||
examn = externalExamExamName
|
||||
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
addAlternatives $
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/examOffice/externalExamResults.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
|
||||
@ -6,7 +6,6 @@ module Jobs.Handler.SynchroniseLdap
|
||||
import Import
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Auth.LDAP
|
||||
|
||||
@ -48,11 +47,7 @@ dispatchJobSynchroniseLdapUser jUser = do
|
||||
$logInfoS "SynchroniseLdap" [st|Synchronising #{userIdent}|]
|
||||
|
||||
ldapAttrs <- MaybeT $ campusUser' ldapConf ldapPool user
|
||||
void . lift $ upsertCampusUser ldapAttrs Creds
|
||||
{ credsIdent = CI.original userIdent
|
||||
, credsPlugin = "dummy"
|
||||
, credsExtra = []
|
||||
}
|
||||
void . lift $ upsertCampusUser UpsertCampusUser ldapAttrs
|
||||
Nothing ->
|
||||
throwM SynchroniseLdapNoLdap
|
||||
where
|
||||
|
||||
@ -89,6 +89,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
|
||||
| NotificationAllocationOutdatedRatings { nAllocation :: AllocationId }
|
||||
| NotificationExamOfficeExamResults { nExam :: ExamId }
|
||||
| NotificationExamOfficeExamResultsChanged { nExamResults :: Set ExamResultId }
|
||||
| NotificationExamOfficeExternalExamResults { nExternalExam :: ExternalExamId }
|
||||
| NotificationAllocationResults { nAllocation :: AllocationId }
|
||||
| NotificationCourseRegistered { nUser :: UserId, nCourse :: CourseId }
|
||||
| NotificationSubmissionEdited { nInitiator :: UserId, nSubmission :: SubmissionId }
|
||||
|
||||
@ -51,6 +51,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
|
||||
| AuthTutor
|
||||
| AuthTutorControl
|
||||
| AuthExamOffice
|
||||
| AuthEvaluation
|
||||
| AuthAllocationRegistered
|
||||
| AuthCourseRegistered
|
||||
| AuthTutorialRegistered
|
||||
|
||||
15
src/Utils.hs
15
src/Utils.hs
@ -8,7 +8,7 @@ import ClassyPrelude.Yesod hiding (foldlM, Proxy, handle, catch)
|
||||
-- import Data.Double.Conversion.Text -- faster implementation for textPercent?
|
||||
import qualified Data.Foldable as Fold
|
||||
import Data.Foldable as Utils (foldlM, foldrM)
|
||||
import Data.Monoid (Sum(..))
|
||||
import Data.Monoid (First, Sum(..))
|
||||
import Data.Proxy
|
||||
|
||||
import Data.CaseInsensitive (CI)
|
||||
@ -381,6 +381,9 @@ setProduct :: Set a -> Set b -> Set (a, b)
|
||||
-- ^ Depends on the valid internal structure of the given sets
|
||||
setProduct (Set.toAscList -> as) (Set.toAscList -> bs) = Set.fromDistinctAscList $ (,) <$> as <*> bs
|
||||
|
||||
setPartitionEithers :: (Ord a, Ord b) => Set (Either a b) -> (Set a, Set b)
|
||||
setPartitionEithers = (,) <$> setMapMaybe (preview _Left) <*> setMapMaybe (preview _Right)
|
||||
|
||||
----------
|
||||
-- Maps --
|
||||
----------
|
||||
@ -985,3 +988,13 @@ unstableSortOn = unstableSortBy . comparing
|
||||
|
||||
unstableSort :: (MonadRandom m, Ord a) => [a] -> m [a]
|
||||
unstableSort = unstableSortBy compare
|
||||
|
||||
----------
|
||||
-- Lens --
|
||||
----------
|
||||
|
||||
mpreview :: (MonadPlus m, MonadReader s m) => Getting (First a) s a -> m a
|
||||
mpreview = hoistMaybe <=< preview
|
||||
|
||||
mpreviews :: (MonadPlus m, MonadReader s m) => Getting (First b) s a -> (a -> b) -> m b
|
||||
mpreviews a f = hoistMaybe =<< previews a f
|
||||
|
||||
@ -49,6 +49,9 @@ _nullable = prism' toNullable fromNullable
|
||||
_SchoolId :: Iso' SchoolId SchoolShorthand
|
||||
_SchoolId = iso unSchoolKey SchoolKey
|
||||
|
||||
_TermId :: Iso' TermId TermIdentifier
|
||||
_TermId = iso unTermKey TermKey
|
||||
|
||||
_StudyTermsId :: Iso' StudyTermsId StudyTermsKey
|
||||
_StudyTermsId = iso unStudyTermsKey StudyTermsKey'
|
||||
|
||||
@ -221,6 +224,11 @@ makeLenses_ ''Tutorial
|
||||
|
||||
makeLenses_ ''SessionFile
|
||||
|
||||
makeLenses_ ''ExternalExam
|
||||
makeLenses_ ''ExternalExamOfficeSchool
|
||||
makeLenses_ ''ExternalExamStaff
|
||||
makeLenses_ ''ExternalExamResult
|
||||
|
||||
|
||||
-- makeClassy_ ''Load
|
||||
|
||||
|
||||
@ -87,7 +87,6 @@ multifocusL = multifocusOptic
|
||||
(\s a -> [t|Lens' $(s) $(a)|])
|
||||
(\doGet doSet -> [e|lens $(doGet) $(doSet)|])
|
||||
|
||||
|
||||
multifocusOptic :: _ -> _ -> _ -> _ -> Natural -> ExpQ
|
||||
multifocusOptic _ _ _ _ 0 = [e|united|]
|
||||
multifocusOptic doClone _ _ _ 1 = doClone
|
||||
|
||||
@ -2,4 +2,8 @@ $newline never
|
||||
<section>
|
||||
^{closeWgt}
|
||||
<section>
|
||||
$if hasUsers
|
||||
<div .notification .notification-info .fa-question .notification--broad>
|
||||
<div .notification__content>
|
||||
_{MsgExamGradesExplanation}
|
||||
^{examUsersTable}
|
||||
|
||||
6
templates/exam-office/externalExamGrades.hamlet
Normal file
6
templates/exam-office/externalExamGrades.hamlet
Normal file
@ -0,0 +1,6 @@
|
||||
$newline never
|
||||
$if hasUsers
|
||||
<div .notification .notification-info .fa-question .notification--broad>
|
||||
<div .notification__content>
|
||||
_{MsgExamGradesExplanation}
|
||||
^{table}
|
||||
62
templates/external-exam-show.hamlet
Normal file
62
templates/external-exam-show.hamlet
Normal file
@ -0,0 +1,62 @@
|
||||
$newline never
|
||||
$maybe ExternalExamResult{externalExamResultResult} <- mResult
|
||||
<section>
|
||||
<h2>
|
||||
_{MsgExamResult}
|
||||
|
||||
<p .result>
|
||||
$case externalExamResultResult
|
||||
$of ExamAttended grade
|
||||
$if externalExamShowGrades
|
||||
_{grade}
|
||||
$else
|
||||
$if view (passingGrade . _Wrapped) grade
|
||||
_{MsgExamPassed}
|
||||
$else
|
||||
_{MsgExamNotPassed}
|
||||
$of ExamNoShow
|
||||
_{MsgExamNoShow}
|
||||
$of ExamVoided
|
||||
_{MsgExamVoided}
|
||||
|
||||
<section>
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>_{MsgTerm}
|
||||
<dd .deflist__dd>
|
||||
_{unTermKey externalExamTerm}
|
||||
<dt .deflist__dt>_{MsgCourseSchool}
|
||||
<dd .deflist__dd>
|
||||
#{schoolName}
|
||||
<dt .deflist__dt>_{MsgCourseName}
|
||||
<dd .deflist__dd>
|
||||
#{externalExamCourseName}
|
||||
<dt .deflist__dt>_{MsgExamName}
|
||||
<dd .deflist__dd>
|
||||
#{externalExamExamName}
|
||||
$maybe examTime <- fmap externalExamResultTime mResult <|> externalExamDefaultTime
|
||||
<dt .deflist__dt>
|
||||
_{MsgExamTime}
|
||||
<dd .deflist__dd>
|
||||
^{formatTimeW SelFormatDateTime examTime}
|
||||
$if not (null addSchools)
|
||||
<dt .deflist__dt>
|
||||
_{MsgExternalExamExamOfficeSchools}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
$forall Entity _ School{schoolName} <- addSchools
|
||||
<li>
|
||||
#{schoolName}
|
||||
$if not (null staff)
|
||||
<dt .deflist__dt>
|
||||
_{MsgExternalExamStaff}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
$forall s <- staff
|
||||
$case s
|
||||
$of Right (Entity _ User{userDisplayName, userDisplayEmail, userSurname})
|
||||
<li>
|
||||
^{nameEmailWidget userDisplayEmail userDisplayName userSurname}
|
||||
$of Left email
|
||||
<li style="font-family: monospace">
|
||||
#{email}
|
||||
|
||||
6
templates/external-exam/schoolMassInput/add.hamlet
Normal file
6
templates/external-exam/schoolMassInput/add.hamlet
Normal file
@ -0,0 +1,6 @@
|
||||
$newline never
|
||||
<td>
|
||||
#{csrf}
|
||||
^{fvInput addView}
|
||||
<td>
|
||||
^{fvInput submitView}
|
||||
3
templates/external-exam/schoolMassInput/cell.hamlet
Normal file
3
templates/external-exam/schoolMassInput/cell.hamlet
Normal file
@ -0,0 +1,3 @@
|
||||
$newline never
|
||||
<td>
|
||||
#{schoolName}
|
||||
11
templates/external-exam/schoolMassInput/layout.hamlet
Normal file
11
templates/external-exam/schoolMassInput/layout.hamlet
Normal file
@ -0,0 +1,11 @@
|
||||
$newline never
|
||||
<table>
|
||||
<tbody>
|
||||
$forall coord <- review liveCoords lLength
|
||||
<tr .massinput__cell>
|
||||
^{cellWdgts ! coord}
|
||||
<td>
|
||||
^{fvInput (delButtons ! coord)}
|
||||
<tfoot>
|
||||
<tr .massinput__cell.massinput__cell--add>
|
||||
^{addWdgts ! (0, 0)}
|
||||
6
templates/external-exam/staffMassInput/add.hamlet
Normal file
6
templates/external-exam/staffMassInput/add.hamlet
Normal file
@ -0,0 +1,6 @@
|
||||
$newline never
|
||||
<td colspan=2>
|
||||
#{csrf}
|
||||
^{fvInput addView}
|
||||
<td>
|
||||
^{fvInput submitView}
|
||||
@ -0,0 +1,6 @@
|
||||
$newline never
|
||||
<td>
|
||||
<span style="font-family: monospace">
|
||||
#{email}
|
||||
<td>
|
||||
^{messageTooltip invWarnMsg}
|
||||
3
templates/external-exam/staffMassInput/cellKnown.hamlet
Normal file
3
templates/external-exam/staffMassInput/cellKnown.hamlet
Normal file
@ -0,0 +1,3 @@
|
||||
$newline never
|
||||
<td colspan=2>
|
||||
^{nameEmailWidget userEmail userDisplayName userSurname}
|
||||
11
templates/external-exam/staffMassInput/layout.hamlet
Normal file
11
templates/external-exam/staffMassInput/layout.hamlet
Normal file
@ -0,0 +1,11 @@
|
||||
$newline never
|
||||
<table>
|
||||
<tbody>
|
||||
$forall coord <- review liveCoords lLength
|
||||
<tr .massinput__cell>
|
||||
^{cellWdgts ! coord}
|
||||
<td>
|
||||
^{fvInput (delButtons ! coord)}
|
||||
<tfoot>
|
||||
<tr .massinput__cell.massinput__cell--add>
|
||||
^{addWdgts ! (0, 0)}
|
||||
@ -1,5 +1,16 @@
|
||||
$newline never
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2020 01 17}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
<li>
|
||||
Eintragung von Ergebnissen für extern (nicht in Uni2work #
|
||||
verwaltete) Klausuren zur Übermittlung an Prüfungsbeauftragte
|
||||
<li>
|
||||
Export von Listen von Kursteilnehmern zur Durchführung von #
|
||||
Kursumfragen
|
||||
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2019 12 05}
|
||||
<dd .deflist__dd>
|
||||
|
||||
@ -1,5 +1,15 @@
|
||||
$newline never
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2020 01 17}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
<li>
|
||||
Support for uploading results of external exams (not managed #
|
||||
within Uni2work).
|
||||
<li>
|
||||
Export of lists of course participants
|
||||
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2019 12 05}
|
||||
<dd .deflist__dd>
|
||||
|
||||
@ -10,37 +10,52 @@ $newline never
|
||||
diesem Fall wird die fehlende Spalte so behandelt als enthielte sie in #
|
||||
jeder Zeile eine leere Zelle).<br />
|
||||
Spalten werden an ihrer Überschrift identifiziert. #
|
||||
Die Überschrift darf daher nicht verändert oder entfernt werden.
|
||||
Die Überschrift darf daher nicht verändert oder entfernt werden.<br />
|
||||
Das verwendete Separator-Zeichen (Komma, Semikolon, Tabulator, #
|
||||
...) wird beim Import automatisch erkannt.<br />
|
||||
Beim Import wird stets die selbe Zeichenkodierung erwartet, wie #
|
||||
sie auch für den CSV-Export eingestellt ist.
|
||||
<dt .deflist__dt>Änderungen
|
||||
<dd .deflist__dd>
|
||||
Einige Zellen können durch den Import verändert werden.<br />
|
||||
Nicht-änderbare Zellen werden ignoriert, falls diese verändert wurden.
|
||||
Bei den meisten Zellen wird durch den Import der Stand der #
|
||||
Datenbank dem Inhalt der Zelle angepasst (z.B. ein #
|
||||
Klausurergebnis).<br />
|
||||
Bei Zellen, wo dies nicht möglich ist (z.B. die #
|
||||
Maximalpunktezahl einer Teilaufgabe), werden etwaige #
|
||||
Unterschiede zum Stand der Datenbank ignoriert.
|
||||
<dt .deflist__dt>Vorschau
|
||||
<dd .deflist__dd>
|
||||
Es wird eine Vorschau angezeigt, bevor irgendetwas tatsächlich geändert wird.<br />
|
||||
In der Vorschau können dann auch nur teilweise Änderungen ausgewählt werden.
|
||||
Es wird eine Vorschau angezeigt, bevor irgendetwas tatsächlich #
|
||||
geändert wird.<br />
|
||||
In der Vorschau kann dann auch eine beliebige Teilmenge der #
|
||||
Änderungen zur Anwendung ausgewählt werden.
|
||||
<dt .deflist__dt>Leere Zellen
|
||||
<dd .deflist__dd>
|
||||
Löschbare Zellen werden durch leere Zellen gelöscht oder auf eindeutige Werte gesetzt.
|
||||
Löschbare Zellen werden durch leere Zellen gelöscht oder auf #
|
||||
eindeutige Werte gesetzt.
|
||||
<dt .deflist__dt>Konsistenz
|
||||
<dd .deflist__dd>
|
||||
<p>
|
||||
Es werden nur konsistente Änderungen akzeptiert!
|
||||
<p>
|
||||
Daraus folgt, dass es sinnvoll sein kann, gewisse Zellen frei zu lassen; #
|
||||
ändert man z.B. die Studienfachzuordnung eines Teilnehmers ab, #
|
||||
so müsste man auch Abschluss und Fachsemester passend ändern.<br />
|
||||
Da diese jedoch eindeutig sind, kann man diese Zellen einfach frei lassen.
|
||||
Daraus folgt, dass es sinnvoll sein kann, gewisse Zellen frei #
|
||||
zu lassen; ändert man z.B. die Studienfachzuordnung eines #
|
||||
Teilnehmers ab, so müsste man auch Abschluss und #
|
||||
Fachsemester passend ändern.<br />
|
||||
Da diese jedoch eindeutig sind, kann man diese Zellen einfach #
|
||||
frei lassen.
|
||||
<dt .deflist__dt>Zeilen Identifikation
|
||||
<dd .deflist__dd>
|
||||
Mehrere Spalten werden zur Identifikation der Zeile verwendet.<br />
|
||||
Es muss nicht in jeder Spalte der Zeile ein Wert vorhanden sein, #
|
||||
so lange die Identifikation noch eindeutig ist.<br />
|
||||
Sind mehrere Werte vorhanden, so müssen diese natürlich zueinander passen.
|
||||
Mehrere Spalten werden zur Identifikation der Zeile #
|
||||
verwendet.<br />
|
||||
Es muss nicht in jeder Spalte der Zeile ein Wert vorhanden #
|
||||
sein, so lange die Identifikation noch eindeutig ist.<br />
|
||||
Sind mehrere Werte vorhanden, so müssen diese natürlich #
|
||||
zueinander passen.
|
||||
<dt .deflist__dt>Zeilen hinzufügen
|
||||
<dd .deflist__dd>
|
||||
Es können auch neue Zeilen hinzugefügt werden, sofern ausreichend #
|
||||
eindeutige Informationen vorhanden sind; #
|
||||
Es können auch neue Zeilen hinzugefügt werden, sofern #
|
||||
ausreichend eindeutige Informationen vorhanden sind; #
|
||||
z.B. können so Prüfungsteilnehmer nachgemeldet werden.
|
||||
<dt .deflist__dt>Zeilen löschen
|
||||
<dd .deflist__dd>
|
||||
|
||||
@ -10,11 +10,20 @@ $newline never
|
||||
the column will be treated as if every cell contained within it was #
|
||||
empty).<br />
|
||||
Columns are identified based on their heading. #
|
||||
Thus column headings may not be modified or removed.
|
||||
Thus column headings may not be modified or removed.<br />
|
||||
The separator character (comma, semicolon, tabulator, ...) is #
|
||||
detected automatically during import.<br />
|
||||
Imported files are expected to use the character encoding, that #
|
||||
is configured for CSV-export.
|
||||
<dt .deflist__dt>Edits
|
||||
<dd .deflist__dd>
|
||||
Some cells can be changed when importing.<br />
|
||||
Cells that cannot be changed are ignored, if they were changed.
|
||||
For most cells, importing changes the current state of the #
|
||||
database to reflect the content of the imported cell (i.e. exam #
|
||||
results).<br />
|
||||
For some cells this is not possible (i.e. the maximum number of #
|
||||
points of an exam part). #
|
||||
In that case all differences between the current state of the #
|
||||
database and the content of the imported cell are ignored.
|
||||
<dt .deflist__dt>Preview
|
||||
<dd .deflist__dd>
|
||||
Before any edits are applied a preview is shown of what would be done.<br />
|
||||
|
||||
18
templates/mail/examOffice/externalExamResults.hamlet
Normal file
18
templates/mail/examOffice/externalExamResults.hamlet
Normal file
@ -0,0 +1,18 @@
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<style>
|
||||
h1 {
|
||||
font-size: 1.25em;
|
||||
font-variant: small-caps;
|
||||
font-weight: normal;
|
||||
}
|
||||
<body>
|
||||
<h1>
|
||||
_{MsgMailExamOfficeExternalExamResultsIntro coursen termDesc externalExamExamName}
|
||||
<p>
|
||||
<a href=@{EExamR tid ssh coursen examn EEGradesR}>
|
||||
#{externalExamExamName}
|
||||
^{editNotifications}
|
||||
17
templates/participants-list.hamlet
Normal file
17
templates/participants-list.hamlet
Normal file
@ -0,0 +1,17 @@
|
||||
$newline never
|
||||
<div .scrolltable .scrolltable--bordered>
|
||||
<table .table .table--striped .table--hover>
|
||||
<thead>
|
||||
<tr .table__row .table__row--head>
|
||||
<th .table__th>_{MsgTerm}
|
||||
$forall school <- schools
|
||||
<th .table__th>#{unSchoolKey school}
|
||||
<tbody>
|
||||
$forall term <- terms
|
||||
<tr .table__row>
|
||||
<th .table__th>_{ShortTermIdentifier (unTermKey term)}
|
||||
$forall school <- schools
|
||||
<td .table__td>
|
||||
$if Set.member (school, term) schoolTerms
|
||||
<a href=@{ParticipantsR term school}>
|
||||
#{iconFileCSV}
|
||||
@ -1,7 +1,10 @@
|
||||
$newline never
|
||||
<div .breadcrumbs__container>
|
||||
<ul .breadcrumbs__list.list--inline>
|
||||
$forall bc <- parents
|
||||
$forall (bcRoute, bcTitle, hasAccess) <- parents
|
||||
<li .breadcrumbs__item>
|
||||
<a .breadcrumbs__link href="@{fst bc}">#{snd bc}
|
||||
$if hasAccess
|
||||
<a .breadcrumbs__link href="@{bcRoute}">#{bcTitle}
|
||||
$else
|
||||
<span .breadcrumbs__link>#{bcTitle}
|
||||
<li .breadcrumbs__last-item>#{title}
|
||||
|
||||
63
templates/widgets/breadcrumbs/breadcrumbs.lucius
Normal file
63
templates/widgets/breadcrumbs/breadcrumbs.lucius
Normal file
@ -0,0 +1,63 @@
|
||||
.breadcrumbs__container {
|
||||
position: relative;
|
||||
color: var(--color-lightwhite);
|
||||
padding: 4px 13px;
|
||||
background-color: var(--color-dark);
|
||||
line-height: 30px;
|
||||
}
|
||||
|
||||
@media (min-width: 426px) {
|
||||
.breadcrumbs__container {
|
||||
padding: 7px 20px;
|
||||
}
|
||||
}
|
||||
|
||||
@media (min-width: 769px) {
|
||||
.breadcrumbs__container {
|
||||
padding: 7px 40px;
|
||||
}
|
||||
}
|
||||
|
||||
a.breadcrumbs__link {
|
||||
color: var(--color-lightwhite);
|
||||
|
||||
&:hover {
|
||||
color: var(--color-white);
|
||||
}
|
||||
}
|
||||
|
||||
.breadcrumbs__item {
|
||||
padding-right: 14px;
|
||||
position: relative;
|
||||
line-height: 28px;
|
||||
opacity: 0.8;
|
||||
z-index: 1;
|
||||
margin-right: 10px;
|
||||
|
||||
&:hover {
|
||||
opacity: 1;
|
||||
}
|
||||
|
||||
&::after {
|
||||
content: '';
|
||||
position: absolute;
|
||||
top: 11px;
|
||||
right: 0;
|
||||
width: 7px;
|
||||
height: 7px;
|
||||
border-style: solid;
|
||||
border-width: 0;
|
||||
border-bottom-width: 1px;
|
||||
border-right-width: 1px;
|
||||
border-color: var(--color-white);
|
||||
transform: rotate(-45deg);
|
||||
z-index: 10;
|
||||
opacity: 1;
|
||||
}
|
||||
}
|
||||
|
||||
.breadcrumbs__last-item {
|
||||
line-height: 28px;
|
||||
vertical-align: bottom;
|
||||
font-weight: 600;
|
||||
}
|
||||
@ -70,6 +70,10 @@ instance Arbitrary ExamOfficeR where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary EExamR where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary CourseNewsR where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
@ -2,9 +2,10 @@ const webpack = require('webpack');
|
||||
const path = require('path');
|
||||
const tmp = require('tmp');
|
||||
tmp.setGracefulCleanup();
|
||||
const fs = require('fs');
|
||||
const fs = require('fs-extra');
|
||||
const glob = require('glob');
|
||||
const { execSync } = require('child_process');
|
||||
const request = require('request-promise');
|
||||
|
||||
const MiniCssExtractPlugin = require('mini-css-extract-plugin');
|
||||
const OptimizeCSSAssetsPlugin = require('optimize-css-assets-webpack-plugin');
|
||||
@ -17,244 +18,316 @@ const HashOutput = require('webpack-plugin-hash-output');
|
||||
const postcssPresetEnv = require('postcss-preset-env');
|
||||
const RemovePlugin = require('remove-files-webpack-plugin');
|
||||
const RealFaviconPlugin = require('real-favicon-webpack-plugin');
|
||||
const crypto = require('crypto');
|
||||
|
||||
const webpackVersion = require('webpack/package.json').version.split('.').slice(0, 2).join('.');
|
||||
const packageVersion = require('./package.json').version;
|
||||
|
||||
module.exports = {
|
||||
module: {
|
||||
rules: [
|
||||
{
|
||||
loader: 'babel-loader',
|
||||
async function webpackConfig() {
|
||||
let faviconApiVersion = undefined;
|
||||
|
||||
options: {
|
||||
plugins: ['syntax-dynamic-import'],
|
||||
try {
|
||||
const faviconApiChangelog = await request({
|
||||
method: 'GET',
|
||||
uri: 'https://realfavicongenerator.net/api/versions',
|
||||
headers: {
|
||||
'Accept': '*/*'
|
||||
},
|
||||
json: true
|
||||
});
|
||||
faviconApiVersion = faviconApiChangelog.filter(vObj => vObj.relevance.automated_update).slice(-1)[0].version;
|
||||
} catch(e) {
|
||||
console.error(e);
|
||||
}
|
||||
|
||||
return {
|
||||
module: {
|
||||
rules: [
|
||||
{
|
||||
loader: 'babel-loader',
|
||||
|
||||
presets: [
|
||||
[
|
||||
'@babel/preset-env',
|
||||
{
|
||||
modules: false,
|
||||
targets: {
|
||||
edge: "17",
|
||||
firefox: "50",
|
||||
chrome: "60",
|
||||
safari: "11.1",
|
||||
ie: "11",
|
||||
},
|
||||
useBuiltIns: "usage",
|
||||
corejs: 3
|
||||
}
|
||||
options: {
|
||||
plugins: ['syntax-dynamic-import'],
|
||||
|
||||
presets: [
|
||||
[
|
||||
'@babel/preset-env',
|
||||
{
|
||||
modules: false,
|
||||
targets: {
|
||||
edge: "17",
|
||||
firefox: "50",
|
||||
chrome: "60",
|
||||
safari: "11.1",
|
||||
ie: "11",
|
||||
},
|
||||
useBuiltIns: "usage",
|
||||
corejs: 3
|
||||
}
|
||||
]
|
||||
]
|
||||
]
|
||||
},
|
||||
test: /\.js$/i,
|
||||
exclude: /node_modules/,
|
||||
},
|
||||
{
|
||||
test: /\.css$/i,
|
||||
use: [ MiniCssExtractPlugin.loader,
|
||||
{ loader: 'css-loader', options: { sourceMap: true }},
|
||||
{ loader: 'postcss-loader', options: {
|
||||
sourceMap: true,
|
||||
plugins: () => [ postcssPresetEnv ]
|
||||
}},
|
||||
{ loader: 'resolve-url-loader', options: { sourceMap: true }}
|
||||
]
|
||||
},
|
||||
{
|
||||
test: /\.s(c|a)ss$/i,
|
||||
use: [ MiniCssExtractPlugin.loader,
|
||||
{ loader: 'css-loader', options: { sourceMap: true }},
|
||||
{ loader: 'postcss-loader', options: {
|
||||
sourceMap: true,
|
||||
plugins: () => [ postcssPresetEnv ]
|
||||
}},
|
||||
{ loader: 'resolve-url-loader', options: { sourceMap: true }},
|
||||
{ loader: 'sass-loader', options: { implementation: require('sass'), sourceMap: true }}
|
||||
]
|
||||
},
|
||||
{
|
||||
test: /\.(woff(2)?|ttf|eot|svg)(\?.*)?$/i,
|
||||
use: [
|
||||
{
|
||||
loader: 'file-loader',
|
||||
options: {
|
||||
name: '[contenthash].[ext]',
|
||||
esModule: false
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
]
|
||||
},
|
||||
|
||||
entry: {
|
||||
main: [ path.resolve(__dirname, 'frontend/src', 'polyfill.js'),
|
||||
path.resolve(__dirname, 'frontend/src', 'main.js')
|
||||
]
|
||||
},
|
||||
|
||||
plugins: [
|
||||
new HashOutput({
|
||||
validateOutput: true,
|
||||
validateOutputRegex: /static\/wp-[^\/]\//
|
||||
}),
|
||||
new MiniCssExtractPlugin({
|
||||
// Options similar to the same options in webpackOptions.output
|
||||
// all options are optional
|
||||
filename: '[chunkhash].css',
|
||||
chunkFilename: '[chunkhash].css',
|
||||
ignoreOrder: false, // Enable to remove warnings about conflicting order
|
||||
}),
|
||||
new webpack.NamedChunksPlugin((chunk) => {
|
||||
if (chunk.name) {
|
||||
return chunk.name;
|
||||
}
|
||||
let modules = chunk.modules || [chunk.entryModule];
|
||||
return modules.map(m => path.relative(m.context, m.request)).join("_");
|
||||
}),
|
||||
new webpack.NamedModulesPlugin(),
|
||||
new ManifestPlugin({
|
||||
fileName: path.resolve(__dirname, 'config', 'webpack.yml'),
|
||||
publicPath: `wp-${webpackVersion}/`,
|
||||
generate: (seed, files, entrypoints) => Object.keys(entrypoints).reduce((acc, fs) => ({...acc, [fs]: files.filter(file => entrypoints[fs].filter(basename => !(/\.map$/.test(basename))).some(basename => file.path.endsWith(basename))).filter(file => file.isInitial).map(file => file.path)}), {}),
|
||||
serialize: yaml.safeDump
|
||||
}),
|
||||
new CleanWebpackPlugin({
|
||||
cleanOnceBeforeBuildPatterns: [ path.resolve(__dirname, 'static'),
|
||||
path.resolve(__dirname, 'well-known'),
|
||||
]
|
||||
}),
|
||||
new webpack.IgnorePlugin(/^\.\/locale$/, /moment$/),
|
||||
new CopyPlugin([
|
||||
{ from: 'assets/lmu/sigillum.svg', to: path.resolve(__dirname, 'static', 'img/lmu/sigillum.svg') },
|
||||
]),
|
||||
new webpack.DefinePlugin({
|
||||
VERSION: JSON.stringify(packageVersion)
|
||||
}),
|
||||
...(() => {
|
||||
const faviconJson = require('./config/favicon.json');
|
||||
const langs = new Set();
|
||||
function findLangs(json) {
|
||||
if (json && json._i18n) {
|
||||
Object.keys(json).forEach(key => {
|
||||
if (key !== '_i18n') {
|
||||
langs.add(key);
|
||||
}
|
||||
})
|
||||
} else if (Array.isArray(json)) {
|
||||
json.forEach(elem => findLangs(elem));
|
||||
} else if (typeof json === 'object') {
|
||||
Object.keys(json).forEach(key => findLangs(json[key]));
|
||||
}
|
||||
}
|
||||
findLangs(faviconJson);
|
||||
|
||||
function selectLang(lang, json) {
|
||||
if (json && json._i18n) {
|
||||
return json[lang];
|
||||
} else if (Array.isArray(json)) {
|
||||
return json.map(elem => selectLang(lang, elem));
|
||||
} else if (typeof json === 'object') {
|
||||
return Object.fromEntries(Object.entries(json).map(([k, v]) => [k, selectLang(lang, v)]));
|
||||
} else {
|
||||
return json;
|
||||
}
|
||||
}
|
||||
|
||||
const langJsons = {};
|
||||
Array.from(langs).forEach(lang => {
|
||||
langJsons[lang] = selectLang(lang, faviconJson);
|
||||
});
|
||||
|
||||
return Array.from(langs).map(lang => {
|
||||
const tmpobj = tmp.fileSync({ dir: ".", postfix: ".json" });
|
||||
fs.writeSync(tmpobj.fd, JSON.stringify(langJsons[lang]));
|
||||
fs.close(tmpobj.fd);
|
||||
|
||||
return [
|
||||
new RealFaviconPlugin({
|
||||
faviconJson: `./${tmpobj.name}`,
|
||||
outputPath: path.resolve(__dirname, 'well-known', lang),
|
||||
inject: false
|
||||
}),
|
||||
new CopyPlugin([
|
||||
{ from: 'config/robots.txt', to: path.resolve(__dirname, 'well-known', lang, 'robots.txt') },
|
||||
])
|
||||
];
|
||||
}).flat(1);
|
||||
})(),
|
||||
{ apply: compiler => compiler.hooks.afterEmit.tap('AfterEmitPlugin', compilation => {
|
||||
const imgFiles = glob.sync(path.resolve(__dirname, 'well-known', '**', '*.@(png)'));
|
||||
const imgFilesArgs = Array.from(imgFiles).join(" ");
|
||||
execSync(`exiftool -overwrite_original -all= ${imgFilesArgs}`, { stdio: 'inherit' });
|
||||
})
|
||||
}
|
||||
],
|
||||
|
||||
output: {
|
||||
chunkFilename: '[chunkhash].js',
|
||||
filename: '[chunkhash].js',
|
||||
path: path.resolve(__dirname, 'static', `wp-${webpackVersion}`),
|
||||
publicPath: `/static/res/wp-${webpackVersion}/`,
|
||||
hashFunction: 'shake256',
|
||||
hashDigestLength: 36
|
||||
},
|
||||
|
||||
optimization: {
|
||||
minimize: true,
|
||||
minimizer: [
|
||||
new TerserPlugin({
|
||||
cache: true,
|
||||
parallel: true,
|
||||
sourceMap: true
|
||||
}),
|
||||
new OptimizeCSSAssetsPlugin({
|
||||
cssProcessorOptions: {
|
||||
map: {
|
||||
inline: false
|
||||
}
|
||||
}
|
||||
})
|
||||
],
|
||||
runtimeChunk: 'single',
|
||||
splitChunks: {
|
||||
chunks: 'all',
|
||||
maxInitialRequests: Infinity,
|
||||
maxAsyncRequests: Infinity,
|
||||
minSize: 0,
|
||||
minChunks: 1,
|
||||
cacheGroups: {
|
||||
vendor: {
|
||||
test(module, chunk) {
|
||||
return module.context.match(/[\\/]node_modules[\\/]/);
|
||||
},
|
||||
name(module, chunks, cacheGroupKey) {
|
||||
const moduleFileName = module.identifier().split('/').reduceRight(item => item);
|
||||
const allChunksNames = chunks.map((item) => item.name).join('~');
|
||||
const packageName = module.context.match(/[\\/]node_modules[\\/](.*?)([\\/]|$)/)[1];
|
||||
|
||||
return `${cacheGroupKey}-${packageName}-${allChunksNames}-${moduleFileName}`;
|
||||
},
|
||||
priority: -10
|
||||
test: /\.js$/i,
|
||||
exclude: /node_modules/,
|
||||
},
|
||||
default: {
|
||||
priority: -20,
|
||||
minChunks: 1
|
||||
{
|
||||
test: /\.css$/i,
|
||||
use: [ MiniCssExtractPlugin.loader,
|
||||
{ loader: 'css-loader', options: { sourceMap: true }},
|
||||
{ loader: 'postcss-loader', options: {
|
||||
sourceMap: true,
|
||||
plugins: () => [ postcssPresetEnv ]
|
||||
}},
|
||||
{ loader: 'resolve-url-loader', options: { sourceMap: true }}
|
||||
]
|
||||
},
|
||||
{
|
||||
test: /\.s(c|a)ss$/i,
|
||||
use: [ MiniCssExtractPlugin.loader,
|
||||
{ loader: 'css-loader', options: { sourceMap: true }},
|
||||
{ loader: 'postcss-loader', options: {
|
||||
sourceMap: true,
|
||||
plugins: () => [ postcssPresetEnv ]
|
||||
}},
|
||||
{ loader: 'resolve-url-loader', options: { sourceMap: true }},
|
||||
{ loader: 'sass-loader', options: { implementation: require('sass'), sourceMap: true }}
|
||||
]
|
||||
},
|
||||
{
|
||||
test: /\.(woff(2)?|ttf|eot|svg)(\?.*)?$/i,
|
||||
use: [
|
||||
{
|
||||
loader: 'file-loader',
|
||||
options: {
|
||||
name: '[contenthash].[ext]',
|
||||
esModule: false
|
||||
}
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
]
|
||||
},
|
||||
moduleIds: 'hashed'
|
||||
},
|
||||
|
||||
mode: 'production',
|
||||
entry: {
|
||||
main: [ path.resolve(__dirname, 'frontend/src', 'polyfill.js'),
|
||||
path.resolve(__dirname, 'frontend/src', 'main.js')
|
||||
]
|
||||
},
|
||||
|
||||
recordsPath: path.join(__dirname, 'records.json'),
|
||||
plugins: [
|
||||
new HashOutput({
|
||||
validateOutput: true,
|
||||
validateOutputRegex: /static\/wp-[^\/]\//
|
||||
}),
|
||||
new MiniCssExtractPlugin({
|
||||
// Options similar to the same options in webpackOptions.output
|
||||
// all options are optional
|
||||
filename: '[chunkhash].css',
|
||||
chunkFilename: '[chunkhash].css',
|
||||
ignoreOrder: false, // Enable to remove warnings about conflicting order
|
||||
}),
|
||||
new webpack.NamedChunksPlugin((chunk) => {
|
||||
if (chunk.name) {
|
||||
return chunk.name;
|
||||
}
|
||||
let modules = chunk.modules || [chunk.entryModule];
|
||||
return modules.map(m => path.relative(m.context, m.request)).join("_");
|
||||
}),
|
||||
new webpack.NamedModulesPlugin(),
|
||||
new ManifestPlugin({
|
||||
fileName: path.resolve(__dirname, 'config', 'webpack.yml'),
|
||||
publicPath: `wp-${webpackVersion}/`,
|
||||
generate: (seed, files, entrypoints) => Object.keys(entrypoints).reduce((acc, fs) => ({...acc, [fs]: files.filter(file => entrypoints[fs].filter(basename => !(/\.map$/.test(basename))).some(basename => file.path.endsWith(basename))).filter(file => file.isInitial).map(file => file.path)}), {}),
|
||||
serialize: yaml.safeDump
|
||||
}),
|
||||
new CleanWebpackPlugin({
|
||||
cleanOnceBeforeBuildPatterns: [ path.resolve(__dirname, 'static'),
|
||||
path.resolve(__dirname, 'well-known'),
|
||||
]
|
||||
}),
|
||||
new webpack.IgnorePlugin(/^\.\/locale$/, /moment$/),
|
||||
new CopyPlugin([
|
||||
{ from: 'assets/lmu/sigillum.svg', to: path.resolve(__dirname, 'static', 'img/lmu/sigillum.svg') },
|
||||
]),
|
||||
new webpack.DefinePlugin({
|
||||
VERSION: JSON.stringify(packageVersion)
|
||||
}),
|
||||
...(() => {
|
||||
const faviconJson = require('./config/favicon.json');
|
||||
const langs = new Set();
|
||||
function findLangs(json) {
|
||||
if (json && json._i18n) {
|
||||
Object.keys(json).forEach(key => {
|
||||
if (key !== '_i18n') {
|
||||
langs.add(key);
|
||||
}
|
||||
})
|
||||
} else if (Array.isArray(json)) {
|
||||
json.forEach(elem => findLangs(elem));
|
||||
} else if (typeof json === 'object') {
|
||||
Object.keys(json).forEach(key => findLangs(json[key]));
|
||||
}
|
||||
}
|
||||
findLangs(faviconJson);
|
||||
|
||||
performance: {
|
||||
assetFilter: (assetFilename) => !(/\.(map|svg|ttf|eot)$/.test(assetFilename))
|
||||
},
|
||||
function selectLang(lang, json) {
|
||||
if (json && json._i18n) {
|
||||
return json[lang];
|
||||
} else if (Array.isArray(json)) {
|
||||
return json.map(elem => selectLang(lang, elem));
|
||||
} else if (typeof json === 'object') {
|
||||
return Object.fromEntries(Object.entries(json).map(([k, v]) => [k, selectLang(lang, v)]));
|
||||
} else {
|
||||
return json;
|
||||
}
|
||||
}
|
||||
|
||||
devtool: 'source-map'
|
||||
};
|
||||
const langJsons = {};
|
||||
Array.from(langs).forEach(lang => {
|
||||
langJsons[lang] = selectLang(lang, faviconJson);
|
||||
});
|
||||
|
||||
const cacheHash = crypto.createHash('sha256');
|
||||
cacheHash.update(JSON.stringify(langJsons));
|
||||
|
||||
const cacheFiles = new Set([
|
||||
...(Array.from(langs).map(lang => path.resolve(__dirname, langJsons[lang].masterPicture))),
|
||||
path.resolve(__dirname, 'config/robots.txt')
|
||||
]);
|
||||
|
||||
for (const cacheFile of cacheFiles) {
|
||||
cacheHash.update(fs.readFileSync(cacheFile));
|
||||
}
|
||||
|
||||
const cacheDigest = cacheHash.copy().digest('hex');
|
||||
|
||||
let cachedVersion = undefined;
|
||||
|
||||
const versionFile = path.resolve(__dirname, '.well-known-cache', `${cacheDigest}.version`);
|
||||
try {
|
||||
if (fs.existsSync(versionFile)) {
|
||||
cachedVersion = fs.readFileSync(versionFile, 'utf8');
|
||||
}
|
||||
} catch (e) {
|
||||
console.error(e);
|
||||
}
|
||||
|
||||
if (faviconApiVersion) {
|
||||
cacheHash.update(faviconApiVersion);
|
||||
}
|
||||
const versionDigest = cacheHash.digest('hex');
|
||||
|
||||
return Array.from(langs).map(lang => {
|
||||
const faviconConfig = { versioning: { param_name: 'v', param_value: versionDigest.substr(0,10) }, ...langJsons[lang] };
|
||||
|
||||
const cacheDirectory = path.resolve(__dirname, '.well-known-cache', `${cacheDigest}-${lang}`);
|
||||
|
||||
if (fs.existsSync(cacheDirectory) && (!faviconApiVersion || faviconApiVersion === cachedVersion)) {
|
||||
console.log(`Using cached well-known from ${cacheDirectory} for ${lang}`);
|
||||
return [
|
||||
new CopyPlugin([
|
||||
{ from: cacheDirectory, to: path.resolve(__dirname, 'well-known', lang) }
|
||||
])
|
||||
];
|
||||
} else {
|
||||
const tmpobj = tmp.fileSync({ dir: ".", postfix: ".json" });
|
||||
fs.writeSync(tmpobj.fd, JSON.stringify(faviconConfig));
|
||||
fs.close(tmpobj.fd);
|
||||
|
||||
return [
|
||||
new RealFaviconPlugin({
|
||||
faviconJson: `./${tmpobj.name}`,
|
||||
outputPath: path.resolve(__dirname, 'well-known', lang),
|
||||
inject: false
|
||||
}),
|
||||
new CopyPlugin([
|
||||
{ from: 'config/robots.txt', to: path.resolve(__dirname, 'well-known', lang, 'robots.txt') },
|
||||
]),
|
||||
{ apply: compiler => compiler.hooks.afterEmit.tap('AfterEmitPlugin', compilation => {
|
||||
const imgFiles = glob.sync(path.resolve(__dirname, 'well-known', lang, '*.@(png)'));
|
||||
const imgFilesArgs = Array.from(imgFiles).join(" ");
|
||||
execSync(`exiftool -overwrite_original -all= ${imgFilesArgs}`, { stdio: 'inherit' });
|
||||
})
|
||||
},
|
||||
{ apply: compiler => compiler.hooks.afterEmit.tap('AfterEmitPlugin', compilation => {
|
||||
fs.ensureDirSync(__dirname, '.well-known-cache');
|
||||
fs.copySync(path.resolve(__dirname, 'well-known', lang), cacheDirectory);
|
||||
if (!fs.existsSync(versionFile)) {
|
||||
fs.writeFileSync(versionFile, faviconApiVersion, { encoding: 'utf8' });
|
||||
}
|
||||
})
|
||||
}
|
||||
];
|
||||
}
|
||||
}).flat(1);
|
||||
})()
|
||||
],
|
||||
|
||||
output: {
|
||||
chunkFilename: '[chunkhash].js',
|
||||
filename: '[chunkhash].js',
|
||||
path: path.resolve(__dirname, 'static', `wp-${webpackVersion}`),
|
||||
publicPath: `/static/res/wp-${webpackVersion}/`,
|
||||
hashFunction: 'shake256',
|
||||
hashDigestLength: 36
|
||||
},
|
||||
|
||||
optimization: {
|
||||
minimize: true,
|
||||
minimizer: [
|
||||
new TerserPlugin({
|
||||
cache: true,
|
||||
parallel: true,
|
||||
sourceMap: true
|
||||
}),
|
||||
new OptimizeCSSAssetsPlugin({
|
||||
cssProcessorOptions: {
|
||||
map: {
|
||||
inline: false
|
||||
}
|
||||
}
|
||||
})
|
||||
],
|
||||
runtimeChunk: 'single',
|
||||
splitChunks: {
|
||||
chunks: 'all',
|
||||
maxInitialRequests: Infinity,
|
||||
maxAsyncRequests: Infinity,
|
||||
minSize: 0,
|
||||
minChunks: 1,
|
||||
cacheGroups: {
|
||||
vendor: {
|
||||
test(module, chunk) {
|
||||
return module.context.match(/[\\/]node_modules[\\/]/);
|
||||
},
|
||||
name(module, chunks, cacheGroupKey) {
|
||||
const moduleFileName = module.identifier().split('/').reduceRight(item => item);
|
||||
const allChunksNames = chunks.map((item) => item.name).join('~');
|
||||
const packageName = module.context.match(/[\\/]node_modules[\\/](.*?)([\\/]|$)/)[1];
|
||||
|
||||
return `${cacheGroupKey}-${packageName}-${allChunksNames}-${moduleFileName}`;
|
||||
},
|
||||
priority: -10
|
||||
},
|
||||
default: {
|
||||
priority: -20,
|
||||
minChunks: 1
|
||||
}
|
||||
}
|
||||
},
|
||||
moduleIds: 'hashed'
|
||||
},
|
||||
|
||||
mode: 'production',
|
||||
|
||||
recordsPath: path.join(__dirname, 'records.json'),
|
||||
|
||||
performance: {
|
||||
assetFilter: (assetFilename) => !(/\.(map|svg|ttf|eot)$/.test(assetFilename))
|
||||
},
|
||||
|
||||
devtool: 'source-map'
|
||||
};
|
||||
}
|
||||
|
||||
module.exports = webpackConfig;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user