diff --git a/.gitignore b/.gitignore index c8a3c4254..f90d75d56 100644 --- a/.gitignore +++ b/.gitignore @@ -38,4 +38,5 @@ test.log tunnel.log /static /well-known +/.well-known-cache /**/tmp-* diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index b6e358687..9780156a1 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -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 diff --git a/CHANGELOG.md b/CHANGELOG.md index 67d9ff907..e7395aaf2 100644 --- a/CHANGELOG.md +++ b/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) diff --git a/config/favicon.json b/config/favicon.json index 2bb896654..f72c235d6 100644 --- a/config/favicon.json +++ b/config/favicon.json @@ -72,6 +72,5 @@ }, "settings": { "html_code_file": true - }, - "versioning": false + } } diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index d5ff609c9..88f55b4ec 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -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. \ No newline at end of file diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index a6bd7cbad..e4b7cf356 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -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}”. diff --git a/missing-translations.sh b/missing-translations.sh new file mode 100755 index 000000000..6cfa7daef --- /dev/null +++ b/missing-translations.sh @@ -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 diff --git a/models/exam-office.model b/models/exam-office.model index dc952c26f..ab45e3abd 100644 --- a/models/exam-office.model +++ b/models/exam-office.model @@ -11,4 +11,9 @@ ExamOfficeResultSynced school SchoolId Maybe office UserId result ExamResultId + time UTCTime +ExamOfficeExternalResultSynced + school SchoolId Maybe + office UserId + result ExternalExamResultId time UTCTime \ No newline at end of file diff --git a/models/external-exams.model b/models/external-exams.model new file mode 100644 index 000000000..bd203fa0d --- /dev/null +++ b/models/external-exams.model @@ -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 \ No newline at end of file diff --git a/package-lock.json b/package-lock.json index de2e8a80c..964ff8b78 100644 --- a/package-lock.json +++ b/package-lock.json @@ -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": { diff --git a/package.json b/package.json index 376b21993..4f5523c9d 100644 --- a/package.json +++ b/package.json @@ -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", diff --git a/package.yaml b/package.yaml index 77d7be724..e2e15ec82 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 10.3.0 +version: 10.4.1 dependencies: - base diff --git a/routes b/routes index 4ee875d7d..f53703e9b 100644 --- a/routes +++ b/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 diff --git a/shell.nix b/shell.nix index 76e71b9ec..08c6dde7c 100644 --- a/shell.nix +++ b/shell.nix @@ -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}" diff --git a/src/Application.hs b/src/Application.hs index 3f4fa2e66..e84ad6bb8 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -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 diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index 8f1520ce3..88add95c9 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -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 diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 5acb12e95..9db9fa7fb 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -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 diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 5eae4b916..8b304ea99 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -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') diff --git a/src/Foundation.hs b/src/Foundation.hs index 09fedd483..8b5ffbf7c 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -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 diff --git a/src/Foundation/Routes.hs b/src/Foundation/Routes.hs index 0e83a0734..afe77ba0e 100644 --- a/src/Foundation/Routes.hs +++ b/src/Foundation/Routes.hs @@ -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 diff --git a/src/Handler/Course/LecturerInvite.hs b/src/Handler/Course/LecturerInvite.hs index 44b27ce64..9d52eeede 100644 --- a/src/Handler/Course/LecturerInvite.hs +++ b/src/Handler/Course/LecturerInvite.hs @@ -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 diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 280a69d6f..99558d12f 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -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 diff --git a/src/Handler/Exam/CorrectorInvite.hs b/src/Handler/Exam/CorrectorInvite.hs index d207ff9ef..2cb691360 100644 --- a/src/Handler/Exam/CorrectorInvite.hs +++ b/src/Handler/Exam/CorrectorInvite.hs @@ -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 diff --git a/src/Handler/Exam/RegistrationInvite.hs b/src/Handler/Exam/RegistrationInvite.hs index cfd109f94..be7decbf4 100644 --- a/src/Handler/Exam/RegistrationInvite.hs +++ b/src/Handler/Exam/RegistrationInvite.hs @@ -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 diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 046d6c7f4..39624ab04 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -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) diff --git a/src/Handler/ExamOffice.hs b/src/Handler/ExamOffice.hs index 5ad3a8bda..de787dfd7 100644 --- a/src/Handler/ExamOffice.hs +++ b/src/Handler/ExamOffice.hs @@ -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 diff --git a/src/Handler/ExamOffice/Exam.hs b/src/Handler/ExamOffice/Exam.hs index 320822663..fbb18a591 100644 --- a/src/Handler/ExamOffice/Exam.hs +++ b/src/Handler/ExamOffice/Exam.hs @@ -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 diff --git a/src/Handler/ExamOffice/Exams.hs b/src/Handler/ExamOffice/Exams.hs index ba3a8f68e..67e15438c 100644 --- a/src/Handler/ExamOffice/Exams.hs +++ b/src/Handler/ExamOffice/Exams.hs @@ -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 diff --git a/src/Handler/ExamOffice/ExternalExam.hs b/src/Handler/ExamOffice/ExternalExam.hs new file mode 100644 index 000000000..2d7978fbc --- /dev/null +++ b/src/Handler/ExamOffice/ExternalExam.hs @@ -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") diff --git a/src/Handler/ExamOffice/Users.hs b/src/Handler/ExamOffice/Users.hs index 3e688c936..fd03b912b 100644 --- a/src/Handler/ExamOffice/Users.hs +++ b/src/Handler/ExamOffice/Users.hs @@ -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 diff --git a/src/Handler/ExternalExam.hs b/src/Handler/ExternalExam.hs new file mode 100644 index 000000000..ac53b0246 --- /dev/null +++ b/src/Handler/ExternalExam.hs @@ -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 diff --git a/src/Handler/ExternalExam/Edit.hs b/src/Handler/ExternalExam/Edit.hs new file mode 100644 index 000000000..76a58dc90 --- /dev/null +++ b/src/Handler/ExternalExam/Edit.hs @@ -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 + } diff --git a/src/Handler/ExternalExam/Form.hs b/src/Handler/ExternalExam/Form.hs new file mode 100644 index 000000000..a8c5d5c18 --- /dev/null +++ b/src/Handler/ExternalExam/Form.hs @@ -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 diff --git a/src/Handler/ExternalExam/List.hs b/src/Handler/ExternalExam/List.hs new file mode 100644 index 000000000..ac8f6e0b2 --- /dev/null +++ b/src/Handler/ExternalExam/List.hs @@ -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 diff --git a/src/Handler/ExternalExam/New.hs b/src/Handler/ExternalExam/New.hs new file mode 100644 index 000000000..36a8cf6ed --- /dev/null +++ b/src/Handler/ExternalExam/New.hs @@ -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 + } diff --git a/src/Handler/ExternalExam/Show.hs b/src/Handler/ExternalExam/Show.hs new file mode 100644 index 000000000..5f9d3fdb4 --- /dev/null +++ b/src/Handler/ExternalExam/Show.hs @@ -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") diff --git a/src/Handler/ExternalExam/StaffInvite.hs b/src/Handler/ExternalExam/StaffInvite.hs new file mode 100644 index 000000000..0e9414913 --- /dev/null +++ b/src/Handler/ExternalExam/StaffInvite.hs @@ -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 diff --git a/src/Handler/ExternalExam/Users.hs b/src/Handler/ExternalExam/Users.hs new file mode 100644 index 000000000..163d086fa --- /dev/null +++ b/src/Handler/ExternalExam/Users.hs @@ -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 diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs new file mode 100644 index 000000000..65e07da1e --- /dev/null +++ b/src/Handler/Participants.hs @@ -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{..} diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index ff7cc41ea..93b6f64ba 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -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 diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 9167d417a..2551f6164 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -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 diff --git a/src/Handler/Tutorial/TutorInvite.hs b/src/Handler/Tutorial/TutorInvite.hs index e78953b67..bcb002f4d 100644 --- a/src/Handler/Tutorial/TutorInvite.hs +++ b/src/Handler/Tutorial/TutorInvite.hs @@ -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 diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 2a580d03f..27c59d743 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -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 diff --git a/src/Handler/Utils/ExamOffice/ExternalExam.hs b/src/Handler/Utils/ExamOffice/ExternalExam.hs new file mode 100644 index 000000000..76a24139c --- /dev/null +++ b/src/Handler/Utils/ExamOffice/ExternalExam.hs @@ -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 diff --git a/src/Handler/Utils/ExternalExam/Users.hs b/src/Handler/Utils/ExternalExam/Users.hs new file mode 100644 index 000000000..3e217429d --- /dev/null +++ b/src/Handler/Utils/ExternalExam/Users.hs @@ -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 + ] diff --git a/src/Handler/Utils/Invitations.hs b/src/Handler/Utils/Invitations.hs index 99bd99691..5e3489ac0 100644 --- a/src/Handler/Utils/Invitations.hs +++ b/src/Handler/Utils/Invitations.hs @@ -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 diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index 150b3ffcd..c1e768f4b 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -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 ) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 06164debb..53184935c 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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 + diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index f7fdfda79..df7125023 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -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 diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs index 814a53407..9c5d81203 100644 --- a/src/Jobs/Crontab.hs +++ b/src/Jobs/Crontab.hs @@ -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 -> diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 6a7b36fcb..c38575bbc 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -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 diff --git a/src/Jobs/Handler/SendNotification/ExamOffice.hs b/src/Jobs/Handler/SendNotification/ExamOffice.hs index a4cc11818..fe7d766e1 100644 --- a/src/Jobs/Handler/SendNotification/ExamOffice.hs +++ b/src/Jobs/Handler/SendNotification/ExamOffice.hs @@ -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)) diff --git a/src/Jobs/Handler/SynchroniseLdap.hs b/src/Jobs/Handler/SynchroniseLdap.hs index 031a5862b..3769f76a4 100644 --- a/src/Jobs/Handler/SynchroniseLdap.hs +++ b/src/Jobs/Handler/SynchroniseLdap.hs @@ -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 diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index b23a68c0d..21bea5be8 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -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 } diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs index ed9139f76..682cbc789 100644 --- a/src/Model/Types/Security.hs +++ b/src/Model/Types/Security.hs @@ -51,6 +51,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä | AuthTutor | AuthTutorControl | AuthExamOffice + | AuthEvaluation | AuthAllocationRegistered | AuthCourseRegistered | AuthTutorialRegistered diff --git a/src/Utils.hs b/src/Utils.hs index f266cece4..f924d3141 100644 --- a/src/Utils.hs +++ b/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 diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index e64bc46a7..1e5042171 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -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 diff --git a/src/Utils/Lens/TH.hs b/src/Utils/Lens/TH.hs index 0042fb308..c4a2f1a82 100644 --- a/src/Utils/Lens/TH.hs +++ b/src/Utils/Lens/TH.hs @@ -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 diff --git a/templates/exam-office/exam-results.hamlet b/templates/exam-office/exam-results.hamlet index efa46523c..29d1ad6c1 100644 --- a/templates/exam-office/exam-results.hamlet +++ b/templates/exam-office/exam-results.hamlet @@ -2,4 +2,8 @@ $newline never
^{closeWgt}
+ $if hasUsers +
+
+ _{MsgExamGradesExplanation} ^{examUsersTable} diff --git a/templates/exam-office/externalExamGrades.hamlet b/templates/exam-office/externalExamGrades.hamlet new file mode 100644 index 000000000..66541d890 --- /dev/null +++ b/templates/exam-office/externalExamGrades.hamlet @@ -0,0 +1,6 @@ +$newline never +$if hasUsers +
+
+ _{MsgExamGradesExplanation} +^{table} diff --git a/templates/external-exam-show.hamlet b/templates/external-exam-show.hamlet new file mode 100644 index 000000000..b8cf6c063 --- /dev/null +++ b/templates/external-exam-show.hamlet @@ -0,0 +1,62 @@ +$newline never +$maybe ExternalExamResult{externalExamResultResult} <- mResult +
+

+ _{MsgExamResult} + +

+ $case externalExamResultResult + $of ExamAttended grade + $if externalExamShowGrades + _{grade} + $else + $if view (passingGrade . _Wrapped) grade + _{MsgExamPassed} + $else + _{MsgExamNotPassed} + $of ExamNoShow + _{MsgExamNoShow} + $of ExamVoided + _{MsgExamVoided} + +

+
+
_{MsgTerm} +
+ _{unTermKey externalExamTerm} +
_{MsgCourseSchool} +
+ #{schoolName} +
_{MsgCourseName} +
+ #{externalExamCourseName} +
_{MsgExamName} +
+ #{externalExamExamName} + $maybe examTime <- fmap externalExamResultTime mResult <|> externalExamDefaultTime +
+ _{MsgExamTime} +
+ ^{formatTimeW SelFormatDateTime examTime} + $if not (null addSchools) +
+ _{MsgExternalExamExamOfficeSchools} +
+
    + $forall Entity _ School{schoolName} <- addSchools +
  • + #{schoolName} + $if not (null staff) +
    + _{MsgExternalExamStaff} +
    +
      + $forall s <- staff + $case s + $of Right (Entity _ User{userDisplayName, userDisplayEmail, userSurname}) +
    • + ^{nameEmailWidget userDisplayEmail userDisplayName userSurname} + $of Left email +
    • + #{email} + diff --git a/templates/external-exam/schoolMassInput/add.hamlet b/templates/external-exam/schoolMassInput/add.hamlet new file mode 100644 index 000000000..cf4cc6e72 --- /dev/null +++ b/templates/external-exam/schoolMassInput/add.hamlet @@ -0,0 +1,6 @@ +$newline never + + #{csrf} + ^{fvInput addView} + + ^{fvInput submitView} diff --git a/templates/external-exam/schoolMassInput/cell.hamlet b/templates/external-exam/schoolMassInput/cell.hamlet new file mode 100644 index 000000000..13905b209 --- /dev/null +++ b/templates/external-exam/schoolMassInput/cell.hamlet @@ -0,0 +1,3 @@ +$newline never + + #{schoolName} diff --git a/templates/external-exam/schoolMassInput/layout.hamlet b/templates/external-exam/schoolMassInput/layout.hamlet new file mode 100644 index 000000000..65352dd95 --- /dev/null +++ b/templates/external-exam/schoolMassInput/layout.hamlet @@ -0,0 +1,11 @@ +$newline never + + + $forall coord <- review liveCoords lLength + + ^{cellWdgts ! coord} + + + ^{addWdgts ! (0, 0)} diff --git a/templates/external-exam/staffMassInput/add.hamlet b/templates/external-exam/staffMassInput/add.hamlet new file mode 100644 index 000000000..bdf6da247 --- /dev/null +++ b/templates/external-exam/staffMassInput/add.hamlet @@ -0,0 +1,6 @@ +$newline never +
      + ^{fvInput (delButtons ! coord)} +
      + #{csrf} + ^{fvInput addView} + + ^{fvInput submitView} diff --git a/templates/external-exam/staffMassInput/cellInvitation.hamlet b/templates/external-exam/staffMassInput/cellInvitation.hamlet new file mode 100644 index 000000000..df7df418a --- /dev/null +++ b/templates/external-exam/staffMassInput/cellInvitation.hamlet @@ -0,0 +1,6 @@ +$newline never + + + #{email} + + ^{messageTooltip invWarnMsg} diff --git a/templates/external-exam/staffMassInput/cellKnown.hamlet b/templates/external-exam/staffMassInput/cellKnown.hamlet new file mode 100644 index 000000000..5ea4cca6f --- /dev/null +++ b/templates/external-exam/staffMassInput/cellKnown.hamlet @@ -0,0 +1,3 @@ +$newline never + + ^{nameEmailWidget userEmail userDisplayName userSurname} diff --git a/templates/external-exam/staffMassInput/layout.hamlet b/templates/external-exam/staffMassInput/layout.hamlet new file mode 100644 index 000000000..65352dd95 --- /dev/null +++ b/templates/external-exam/staffMassInput/layout.hamlet @@ -0,0 +1,11 @@ +$newline never + + + $forall coord <- review liveCoords lLength + + ^{cellWdgts ! coord} + + + ^{addWdgts ! (0, 0)} diff --git a/templates/i18n/changelog/de-de-formal.hamlet b/templates/i18n/changelog/de-de-formal.hamlet index ad97f3dae..3da252aaa 100644 --- a/templates/i18n/changelog/de-de-formal.hamlet +++ b/templates/i18n/changelog/de-de-formal.hamlet @@ -1,5 +1,16 @@ $newline never
      +
      + ^{formatGregorianW 2020 01 17} +
      +
        +
      • + Eintragung von Ergebnissen für extern (nicht in Uni2work # + verwaltete) Klausuren zur Übermittlung an Prüfungsbeauftragte +
      • + Export von Listen von Kursteilnehmern zur Durchführung von # + Kursumfragen +
        ^{formatGregorianW 2019 12 05}
        diff --git a/templates/i18n/changelog/en-eu.hamlet b/templates/i18n/changelog/en-eu.hamlet index 3e5ff69ad..bb0c941cb 100644 --- a/templates/i18n/changelog/en-eu.hamlet +++ b/templates/i18n/changelog/en-eu.hamlet @@ -1,5 +1,15 @@ $newline never
        +
        + ^{formatGregorianW 2020 01 17} +
        +
          +
        • + Support for uploading results of external exams (not managed # + within Uni2work). +
        • + Export of lists of course participants +
          ^{formatGregorianW 2019 12 05}
          diff --git a/templates/i18n/table/csv-import-explanation/de-de-formal.hamlet b/templates/i18n/table/csv-import-explanation/de-de-formal.hamlet index 33d4609ef..992aba4b6 100644 --- a/templates/i18n/table/csv-import-explanation/de-de-formal.hamlet +++ b/templates/i18n/table/csv-import-explanation/de-de-formal.hamlet @@ -10,37 +10,52 @@ $newline never diesem Fall wird die fehlende Spalte so behandelt als enthielte sie in # jeder Zeile eine leere Zelle).
          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.
          + Das verwendete Separator-Zeichen (Komma, Semikolon, Tabulator, # + ...) wird beim Import automatisch erkannt.
          + Beim Import wird stets die selbe Zeichenkodierung erwartet, wie # + sie auch für den CSV-Export eingestellt ist.
          Änderungen
          - Einige Zellen können durch den Import verändert werden.
          - 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).
          + Bei Zellen, wo dies nicht möglich ist (z.B. die # + Maximalpunktezahl einer Teilaufgabe), werden etwaige # + Unterschiede zum Stand der Datenbank ignoriert.
          Vorschau
          - Es wird eine Vorschau angezeigt, bevor irgendetwas tatsächlich geändert wird.
          - 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.
          + In der Vorschau kann dann auch eine beliebige Teilmenge der # + Änderungen zur Anwendung ausgewählt werden.
          Leere Zellen
          - 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.
          Konsistenz

          Es werden nur konsistente Änderungen akzeptiert!

          - 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.
          - 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.
          + Da diese jedoch eindeutig sind, kann man diese Zellen einfach # + frei lassen.

          Zeilen Identifikation
          - Mehrere Spalten werden zur Identifikation der Zeile verwendet.
          - Es muss nicht in jeder Spalte der Zeile ein Wert vorhanden sein, # - so lange die Identifikation noch eindeutig ist.
          - Sind mehrere Werte vorhanden, so müssen diese natürlich zueinander passen. + Mehrere Spalten werden zur Identifikation der Zeile # + verwendet.
          + Es muss nicht in jeder Spalte der Zeile ein Wert vorhanden # + sein, so lange die Identifikation noch eindeutig ist.
          + Sind mehrere Werte vorhanden, so müssen diese natürlich # + zueinander passen.
          Zeilen hinzufügen
          - 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.
          Zeilen löschen
          diff --git a/templates/i18n/table/csv-import-explanation/en-eu.hamlet b/templates/i18n/table/csv-import-explanation/en-eu.hamlet index a22231c5a..f6205dbda 100644 --- a/templates/i18n/table/csv-import-explanation/en-eu.hamlet +++ b/templates/i18n/table/csv-import-explanation/en-eu.hamlet @@ -10,11 +10,20 @@ $newline never the column will be treated as if every cell contained within it was # empty).
          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.
          + The separator character (comma, semicolon, tabulator, ...) is # + detected automatically during import.
          + Imported files are expected to use the character encoding, that # + is configured for CSV-export.
          Edits
          - Some cells can be changed when importing.
          - 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).
          + 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.
          Preview
          Before any edits are applied a preview is shown of what would be done.
          diff --git a/templates/mail/examOffice/externalExamResults.hamlet b/templates/mail/examOffice/externalExamResults.hamlet new file mode 100644 index 000000000..65c73c705 --- /dev/null +++ b/templates/mail/examOffice/externalExamResults.hamlet @@ -0,0 +1,18 @@ +$newline never +\ + + + +
      + ^{fvInput (delButtons ! coord)} +