Merge branch '155-zentralanmeldungen'
This commit is contained in:
Gregor Kleen
commit
2a804c8a39
@ -7,6 +7,8 @@ BtnRegister: Anmelden
|
|||||||
BtnDeregister: Abmelden
|
BtnDeregister: Abmelden
|
||||||
BtnCourseRegister: Zum Kurs anmelden
|
BtnCourseRegister: Zum Kurs anmelden
|
||||||
BtnCourseDeregister: Vom Kurs abmelden
|
BtnCourseDeregister: Vom Kurs abmelden
|
||||||
|
BtnCourseApply: Zum Kurs bewerben
|
||||||
|
BtnCourseRetractApplication: Bewerbung zum Kurs zurückziehen
|
||||||
BtnExamRegister: Anmelden zur Prüfung
|
BtnExamRegister: Anmelden zur Prüfung
|
||||||
BtnExamDeregister: Von der Prüfung abmelden
|
BtnExamDeregister: Von der Prüfung abmelden
|
||||||
BtnHijack: Sitzung übernehmen
|
BtnHijack: Sitzung übernehmen
|
||||||
@ -86,16 +88,19 @@ CourseCapacityTip: Anzahl erlaubter Kursanmeldungen, leer lassen für unbeschrä
|
|||||||
CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
|
CourseNoCapacity: In diesem Kurs sind keine Plätze mehr frei.
|
||||||
TutorialNoCapacity: In dieser Übung sind keine Plätze mehr frei.
|
TutorialNoCapacity: In dieser Übung sind keine Plätze mehr frei.
|
||||||
CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
|
CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
|
||||||
|
CourseRegistration: Kursanmeldung
|
||||||
CourseRegisterOpen: Anmeldung möglich
|
CourseRegisterOpen: Anmeldung möglich
|
||||||
CourseRegisterOk: Anmeldung erfolgreich
|
CourseRegisterOk: Erfolgreich zum Kurs angemeldet
|
||||||
CourseDeregisterOk: Erfolgreich abgemeldet
|
CourseDeregisterOk: Erfolgreich vom Kurs abgemeldet
|
||||||
|
CourseApplyOk: Erfolgreich zum Kurs beworben
|
||||||
|
CourseRetractApplyOk: Bewerbung zum Kurs erfolgreich zurückgezogen
|
||||||
CourseDeregisterLecturerTip: Wenn Sie den Teilnehmer vom Kurs abmelden kann es sein, dass sie Zugriff auf diese Daten verlieren
|
CourseDeregisterLecturerTip: Wenn Sie den Teilnehmer vom Kurs abmelden kann es sein, dass sie Zugriff auf diese Daten verlieren
|
||||||
CourseStudyFeature: Assoziiertes Hauptfach
|
CourseStudyFeature: Assoziiertes Studienfach
|
||||||
CourseStudyFeatureUpdated: Assoziiertes Hauptfach geändert
|
CourseStudyFeatureTip: Dient ausschließlich der Information der Kursverwalter
|
||||||
CourseStudyFeatureNone: Kein assoziiertes Hauptfach
|
CourseStudyFeatureUpdated: Assoziiertes Studienfach geändert
|
||||||
|
CourseStudyFeatureNone: Kein assoziiertes Studienfach
|
||||||
CourseTutorial: Tutorium
|
CourseTutorial: Tutorium
|
||||||
CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen
|
CourseSecretWrong: Falsches Passwort
|
||||||
CourseSecretWrong: Falsches Kennwort
|
|
||||||
CourseSecret: Zugangspasswort
|
CourseSecret: Zugangspasswort
|
||||||
CourseEditOk tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} wurde erfolgreich geändert.
|
CourseEditOk tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} wurde erfolgreich geändert.
|
||||||
CourseNewDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester.
|
CourseNewDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester.
|
||||||
@ -113,7 +118,7 @@ CourseMembers: Teilnehmer
|
|||||||
CourseMemberOf: Teilnehmer
|
CourseMemberOf: Teilnehmer
|
||||||
CourseMembersCount n@Int: #{n}
|
CourseMembersCount n@Int: #{n}
|
||||||
CourseMembersCountLimited n@Int max@Int: #{n}/#{max}
|
CourseMembersCountLimited n@Int max@Int: #{n}/#{max}
|
||||||
CourseMembersCountOf n@Int mbNum@IntMaybe: #{n} Anmeldungen #{maybeToMessage " von " mbNum " möglichen"}
|
CourseMembersCountOf n@Int mbNum@IntMaybe: #{n} Kursanmeldungen #{maybeToMessage " von " mbNum " möglichen"}
|
||||||
CourseName: Name
|
CourseName: Name
|
||||||
CourseDescription: Beschreibung
|
CourseDescription: Beschreibung
|
||||||
CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet
|
CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet
|
||||||
@ -137,8 +142,8 @@ CourseUserNote: Notiz
|
|||||||
CourseUserNoteTooltip: Nur für Dozenten dieses Kurses einsehbar
|
CourseUserNoteTooltip: Nur für Dozenten dieses Kurses einsehbar
|
||||||
CourseUserNoteSaved: Notizänderungen gespeichert
|
CourseUserNoteSaved: Notizänderungen gespeichert
|
||||||
CourseUserNoteDeleted: Teilnehmernotiz gelöscht
|
CourseUserNoteDeleted: Teilnehmernotiz gelöscht
|
||||||
CourseUserDeregister: Abmelden
|
CourseUserDeregister: Vom Kurs abmelden
|
||||||
CourseUsersDeregistered count@Int64: #{show count} Teilnehmer abgemeldet
|
CourseUsersDeregistered count@Int64: #{show count} Teilnehmer vom Kurs abgemeldet
|
||||||
CourseUserSendMail: Mitteilung verschicken
|
CourseUserSendMail: Mitteilung verschicken
|
||||||
TutorialUserDeregister: Vom Tutorium Abmelden
|
TutorialUserDeregister: Vom Tutorium Abmelden
|
||||||
TutorialUserSendMail: Mitteilung verschicken
|
TutorialUserSendMail: Mitteilung verschicken
|
||||||
@ -150,20 +155,48 @@ CourseAllocationOption term@Text name@Text: #{name} (#{term})
|
|||||||
CourseAllocationMinCapacity: Minimale Teilnehmeranzahl
|
CourseAllocationMinCapacity: Minimale Teilnehmeranzahl
|
||||||
CourseAllocationMinCapacityTip: Wenn der Veranstaltung bei der Zentralanmeldung weniger als diese Anzahl von Teilnehmern zugeteilt würden, werden diese stattdessen auf andere Kurse umverteilt
|
CourseAllocationMinCapacityTip: Wenn der Veranstaltung bei der Zentralanmeldung weniger als diese Anzahl von Teilnehmern zugeteilt würden, werden diese stattdessen auf andere Kurse umverteilt
|
||||||
CourseAllocationMinCapacityMustBeNonNegative: Minimale Teilnehmeranzahl darf nicht negativ sein
|
CourseAllocationMinCapacityMustBeNonNegative: Minimale Teilnehmeranzahl darf nicht negativ sein
|
||||||
CourseAllocationInstructions: Anweisungen zur Bewerbung
|
CourseApplicationInstructions: Anweisungen zur Bewerbung/Anmeldung
|
||||||
CourseAllocationInstructionsTip: Wird den Studierenden angezeigt, wenn diese sich für Ihre Veranstaltung bewerben
|
CourseApplicationInstructionsTip: Wird den Studierenden angezeigt, wenn diese sich für Ihre Veranstaltung bewerben bzw. bei dieser anmelden
|
||||||
CourseAllocationApplicationTemplate: Bewerbungsvorlagen
|
CourseApplicationTemplate: Bewerbungsvorlagen
|
||||||
CourseAllocationApplicationText: Text-Bewerbungen
|
CourseApplicationTemplateTip: Werden den Studierenden zum download angeboten, wenn diese sich für Ihre Veranstaltung bewerben bzw. bei dieser anmelden
|
||||||
CourseAllocationApplicationTextTip: Sollen die Studierenden Bewerbungen (ggf. zusätzlich zu abgegebenen Dateien) als unformatierten Text einreichen?
|
CourseApplicationsText: Text-Bewerbungen
|
||||||
CourseAllocationApplicationRatingsVisible: Feedback für Bewerbungen
|
CourseApplicationsTextTip: Sollen die Studierenden Bewerbungen (ggf. zusätzlich zu abgegebenen Dateien) als unformatierten Text einreichen?
|
||||||
CourseAllocationApplicationRatingsVisibleTip: Sollen Bewertung und Kommentar der Bewerbungen den Studierenden nach Ende der Bewertungs-Phase angezeigt werden?
|
CourseApplicationRatingsVisible: Feedback für Bewerbungen
|
||||||
|
CourseApplicationRatingsVisibleTip: Sollen Bewertung und Kommentar der Bewerbungen den Studierenden nach Ende der Bewertungs-Phase angezeigt werden?
|
||||||
|
CourseApplicationRequired: Bewerbungsverfahren
|
||||||
|
CourseApplicationRequiredTip: Sollen Anmeldungen zu diesem Kurs zunächst provisorisch (ohne Kapazitätsbeschränkung) sein, bis sie durch einen Kursverwalter (nach Bewertung der Bewerbungen) akzeptiert werden?
|
||||||
|
CourseApplicationInstructionsApplication: Anweisungen zur Bewerbung
|
||||||
|
CourseApplicationInstructionsRegistration: Anweisungen zur Anmeldung
|
||||||
|
CourseApplicationTemplateApplication: Bewerbungsvorlage(n)
|
||||||
|
CourseApplicationTemplateRegistration: Anmeldungsvorlage(n)
|
||||||
|
CourseApplicationTemplateArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungsvorlagen
|
||||||
|
|
||||||
|
CourseApplicationText: Text-Bewerbung
|
||||||
|
CourseApplicationFollowInstructions: Beachten Sie die Anweisungen zur Bewerbung!
|
||||||
|
CourseRegistrationText: Text zur Anmeldung
|
||||||
|
CourseRegistrationFollowInstructions: Beachten Sie die Anweisungen zur Anmeldung!
|
||||||
|
|
||||||
|
CourseApplicationFile: Bewerbung
|
||||||
|
CourseApplicationFiles: Bewerbungsdatei(en)
|
||||||
|
CourseApplicationArchive: Zip-Archiv der Bewerbungsdatei(en)
|
||||||
|
CourseRegistrationFile: Datei zur Anmeldung
|
||||||
|
CourseRegistrationFiles: Datei(en) zur Anmeldung
|
||||||
|
CourseRegistrationArchive: Zip-Archiv der Datei(en) zur Anmeldung
|
||||||
|
CourseApplicationNoFiles: Keine Datei(en)
|
||||||
|
|
||||||
|
CourseApplicationDeleteToEdit: Um Ihre Bewerbung zu editieren müssen Sie sie zunächst zurückziehen und sich erneut bewerben.
|
||||||
|
CourseRegistrationDeleteToEdit: Um Ihre Anmeldungsdaten zu editieren müssen Sie sich zunächst ab- und dann erneut anmelden.
|
||||||
|
|
||||||
|
CourseLoginToApply: Um sich zum Kurz zu bewerben müssen Sie sich zunächst in Uni2work anmelden
|
||||||
|
CourseLoginToRegister: Um sich zum Kurs anzumelden müssen Sie zunächst in Uni2work anmelden
|
||||||
|
|
||||||
|
CourseApplicationArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand appId@CryptoFileNameCourseApplication displayName@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldCase (toPathPiece appId)}-#{foldCase displayName}
|
||||||
|
|
||||||
CourseNoAllocationsAvailable: Es sind aktuell keine Zentralanmeldungen verfügbar
|
CourseNoAllocationsAvailable: Es sind aktuell keine Zentralanmeldungen verfügbar
|
||||||
AllocationStaffRegisterToExpired: Es dürfen keine Änderungen an der Eintragung des Kurses zur Zentralanmeldung mehr vorgenommen werden
|
AllocationStaffRegisterToExpired: Es dürfen keine Änderungen an der Eintragung des Kurses zur Zentralanmeldung mehr vorgenommen werden
|
||||||
|
|
||||||
|
|
||||||
CourseFormSectionRegistration: Anmeldung
|
CourseFormSectionRegistration: Anmeldung zum Kurs
|
||||||
CourseFormSectionAdministration: Verwaltung
|
CourseFormSectionAdministration: Verwaltung
|
||||||
|
|
||||||
CourseLecturers: Kursverwalter
|
CourseLecturers: Kursverwalter
|
||||||
@ -293,11 +326,13 @@ MaterialDeleteCaption: Wollen Sie das unten aufgeführte Material wirklich lösc
|
|||||||
MaterialDelHasFiles count@Int64: inklusive #{count} #{pluralDE count "Datei" "Dateien"}
|
MaterialDelHasFiles count@Int64: inklusive #{count} #{pluralDE count "Datei" "Dateien"}
|
||||||
MaterialIsVisible: Achtung, dieses Material wurde bereits veröffentlicht.
|
MaterialIsVisible: Achtung, dieses Material wurde bereits veröffentlicht.
|
||||||
MaterialDeleted materialName@MaterialName: Material "#{materialName}" gelöscht
|
MaterialDeleted materialName@MaterialName: Material "#{materialName}" gelöscht
|
||||||
|
MaterialArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand materialName@MaterialName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase materialName}
|
||||||
|
|
||||||
|
|
||||||
Unauthorized: Sie haben hierfür keine explizite Berechtigung.
|
Unauthorized: Sie haben hierfür keine explizite Berechtigung.
|
||||||
UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})
|
UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})
|
||||||
UnauthorizedOr l@Text r@Text: (#{l} ODER #{r})
|
UnauthorizedOr l@Text r@Text: (#{l} ODER #{r})
|
||||||
|
UnauthorizedNot i@Text: (NICHT #{i})
|
||||||
UnauthorizedNoToken: Ihrer Anfrage war kein Authorisierungs-Token beigefügt.
|
UnauthorizedNoToken: Ihrer Anfrage war kein Authorisierungs-Token beigefügt.
|
||||||
UnauthorizedTokenExpired: Ihr Authorisierungs-Token ist abgelaufen.
|
UnauthorizedTokenExpired: Ihr Authorisierungs-Token ist abgelaufen.
|
||||||
UnauthorizedTokenNotStarted: Ihr Authorisierungs-Token ist noch nicht gültig.
|
UnauthorizedTokenNotStarted: Ihr Authorisierungs-Token ist noch nicht gültig.
|
||||||
@ -314,9 +349,11 @@ UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung ein
|
|||||||
UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen.
|
UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen.
|
||||||
UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen.
|
UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen.
|
||||||
UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.
|
UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.
|
||||||
|
UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
|
||||||
UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
|
UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
|
||||||
UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
|
UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
|
||||||
UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
|
UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
|
||||||
|
UnauthorizedApplicationTime: Diese Bewerbung ist momentan nicht freigegeben.
|
||||||
UnauthorizedMaterialTime: Dieses Material ist momentan nicht freigegeben.
|
UnauthorizedMaterialTime: Dieses Material ist momentan nicht freigegeben.
|
||||||
UnauthorizedTutorialTime: Dieses Tutorium erlaubt momentan keine Anmeldungen.
|
UnauthorizedTutorialTime: Dieses Tutorium erlaubt momentan keine Anmeldungen.
|
||||||
UnauthorizedExamTime: Diese Prüfung ist momentan nicht freigegeben.
|
UnauthorizedExamTime: Diese Prüfung ist momentan nicht freigegeben.
|
||||||
@ -448,6 +485,10 @@ UpdatedSheetCorrectorsAutoFailed n@Int: #{n} #{pluralDE n "Abgabe konnte" "Abgab
|
|||||||
CouldNotAssignCorrectorsAuto num@Int64: #{num} Abgaben konnten nicht automatisch zugewiesen werden:
|
CouldNotAssignCorrectorsAuto num@Int64: #{num} Abgaben konnten nicht automatisch zugewiesen werden:
|
||||||
SelfCorrectors num@Int64: #{num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt!
|
SelfCorrectors num@Int64: #{num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt!
|
||||||
|
|
||||||
|
SubmissionOriginal: Original
|
||||||
|
SubmissionCorrected: Korrigiert
|
||||||
|
SubmissionArchiveName: abgaben
|
||||||
|
SubmissionTypeArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName subId@CryptoFileNameSubmission renderedSfType@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}-#{foldCase (toPathPiece subId)}-#{foldCase renderedSfType}
|
||||||
|
|
||||||
CorrectionSheets: Übersicht Korrekturen nach Blättern
|
CorrectionSheets: Übersicht Korrekturen nach Blättern
|
||||||
CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren
|
CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren
|
||||||
@ -647,7 +688,7 @@ StudyFeatureAge: Fachsemester
|
|||||||
StudyFeatureDegree: Abschluss
|
StudyFeatureDegree: Abschluss
|
||||||
FieldPrimary: Hauptfach
|
FieldPrimary: Hauptfach
|
||||||
FieldSecondary: Nebenfach
|
FieldSecondary: Nebenfach
|
||||||
NoPrimaryStudyField: (kein Hauptfach registriert)
|
NoStudyField: Kein Studienfach
|
||||||
StudyFeatureType:
|
StudyFeatureType:
|
||||||
StudyFeatureValid: Aktiv
|
StudyFeatureValid: Aktiv
|
||||||
StudyFeatureUpdate: Abgeglichen
|
StudyFeatureUpdate: Abgeglichen
|
||||||
@ -775,6 +816,9 @@ SheetGroupMaxGroupsize: Maximale Gruppengröße
|
|||||||
SheetFiles: Übungsblatt-Dateien
|
SheetFiles: Übungsblatt-Dateien
|
||||||
SheetFileTypeHeader: Zugehörigkeit
|
SheetFileTypeHeader: Zugehörigkeit
|
||||||
|
|
||||||
|
SheetArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}
|
||||||
|
SheetTypeArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName renderedSft@Text: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-#{foldedCase shn}-#{foldCase renderedSft}
|
||||||
|
|
||||||
NotificationTriggerSubmissionRatedGraded: Meine Abgabe in einem gewerteten Übungsblatt wurde korrigiert
|
NotificationTriggerSubmissionRatedGraded: Meine Abgabe in einem gewerteten Übungsblatt wurde korrigiert
|
||||||
NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert
|
NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert
|
||||||
NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen
|
NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen
|
||||||
@ -974,6 +1018,7 @@ AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind er
|
|||||||
AuthTagCourseRegistered: Nutzer ist Kursteilnehmer
|
AuthTagCourseRegistered: Nutzer ist Kursteilnehmer
|
||||||
AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
|
AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
|
||||||
AuthTagExamRegistered: Nutzer ist Prüfungsteilnehmer
|
AuthTagExamRegistered: Nutzer ist Prüfungsteilnehmer
|
||||||
|
AuthTagExamResult: Nutzer hat Prüfungsergebnisse
|
||||||
AuthTagParticipant: Nutzer ist mit Kurs assoziiert
|
AuthTagParticipant: Nutzer ist mit Kurs assoziiert
|
||||||
AuthTagRegisterGroup: Nutzer ist nicht Mitglied eines anderen Tutoriums mit der selben Registrierungs-Gruppe
|
AuthTagRegisterGroup: Nutzer ist nicht Mitglied eines anderen Tutoriums mit der selben Registrierungs-Gruppe
|
||||||
AuthTagCapacity: Kapazität ist ausreichend
|
AuthTagCapacity: Kapazität ist ausreichend
|
||||||
@ -1151,13 +1196,13 @@ HealthActiveJobExecutors: Anteil der job-workers, die neue Befehle annehmen
|
|||||||
CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer
|
CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer
|
||||||
CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
|
CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
|
||||||
CourseParticipantsAlreadyRegistered n@Int: #{n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
|
CourseParticipantsAlreadyRegistered n@Int: #{n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
|
||||||
CourseParticipantsRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden ohne assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
|
CourseParticipantsRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Studienfach" "wurden ohne assoziierte Studienfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
|
||||||
CourseParticipantsRegistered n@Int: #{n} Teilnehmer erfolgreich angemeldet
|
CourseParticipantsRegistered n@Int: #{n} Teilnehmer erfolgreich angemeldet
|
||||||
CourseParticipantsRegisterHeading: Kursteilnehmer hinzufügen
|
CourseParticipantsRegisterHeading: Kursteilnehmer hinzufügen
|
||||||
|
|
||||||
ExamRegistrationAndCourseParticipantsRegistered n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} sowohl zum Kurs, als auch zur Prüfung angemeldet
|
ExamRegistrationAndCourseParticipantsRegistered n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} sowohl zum Kurs, als auch zur Prüfung angemeldet
|
||||||
ExamRegistrationNotRegisteredWithoutCourse n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} nicht zur Prüfung angemeldet, da #{pluralDE n "er" "sie"} nicht zum Kurs angemeldet #{pluralDE n "ist" "sind"}
|
ExamRegistrationNotRegisteredWithoutCourse n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} nicht zur Prüfung angemeldet, da #{pluralDE n "er" "sie"} nicht zum Kurs angemeldet #{pluralDE n "ist" "sind"}
|
||||||
ExamRegistrationRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} sowohl zur Prüfung, als auch #{pluralDE n "ohne assoziiertes Hauptfach" "ohne assoziierte Hauptfächer"} zum Kurs angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
|
ExamRegistrationRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} sowohl zur Prüfung, als auch #{pluralDE n "ohne assoziiertes Studienfach" "ohne assoziierte Studienfächer"} zum Kurs angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
|
||||||
ExamRegistrationParticipantsRegistered n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} zur Prüfung angemeldet
|
ExamRegistrationParticipantsRegistered n@Int: #{n} Teilnehmer #{pluralDE n "wurde" "wurden"} zur Prüfung angemeldet
|
||||||
ExamRegistrationInviteDeadline: Einladung nur gültig bis
|
ExamRegistrationInviteDeadline: Einladung nur gültig bis
|
||||||
ExamRegistrationEnlistDirectly: Bekannte Nutzer sofort als Teilnehmer eintragen
|
ExamRegistrationEnlistDirectly: Bekannte Nutzer sofort als Teilnehmer eintragen
|
||||||
@ -1267,11 +1312,11 @@ ExamPassed: Bestanden
|
|||||||
ExamNotPassed: Nicht bestanden
|
ExamNotPassed: Nicht bestanden
|
||||||
ExamResult: Prüfungsergebnis
|
ExamResult: Prüfungsergebnis
|
||||||
|
|
||||||
ExamRegisteredSuccess exam@ExamName: Erfolgreich zur #{exam} angemeldet
|
ExamRegisteredSuccess exam@ExamName: Erfolgreich zur Prüfung #{exam} angemeldet
|
||||||
ExamDeregisteredSuccess exam@ExamName: Erfolgreich von der #{exam} abgemeldet
|
ExamDeregisteredSuccess exam@ExamName: Erfolgreich von der Prüfung #{exam} abgemeldet
|
||||||
ExamRegistered: Angemeldet
|
ExamRegistered: Zur Prüfung angemeldet
|
||||||
ExamNotRegistered: Nicht angemeldet
|
ExamNotRegistered: Nicht zur Prüfung angemeldet
|
||||||
ExamRegistration: Anmeldung
|
ExamRegistration: Prüfungsanmeldung
|
||||||
|
|
||||||
ExamRegisterToMustBeAfterRegisterFrom: "Anmeldung ab" muss vor "Anmeldung bis" liegen
|
ExamRegisterToMustBeAfterRegisterFrom: "Anmeldung ab" muss vor "Anmeldung bis" liegen
|
||||||
ExamDeregisterUntilMustBeAfterRegisterFrom: "Abmeldung bis" muss nach "Anmeldung bis" liegen
|
ExamDeregisterUntilMustBeAfterRegisterFrom: "Abmeldung bis" muss nach "Anmeldung bis" liegen
|
||||||
@ -1296,7 +1341,7 @@ ImplementationDetails: Implementierung
|
|||||||
ExamUsersHeading: Prüfungsteilnehmer
|
ExamUsersHeading: Prüfungsteilnehmer
|
||||||
ExamUserDeregister: Teilnehmer von Prüfung abmelden
|
ExamUserDeregister: Teilnehmer von Prüfung abmelden
|
||||||
ExamUserAssignOccurrence: Termin/Raum zuweisen
|
ExamUserAssignOccurrence: Termin/Raum zuweisen
|
||||||
ExamUsersDeregistered count@Int64: #{show count} Teilnehmer abgemeldet
|
ExamUsersDeregistered count@Int64: #{show count} Teilnehmer von der Prüfung abgemeldet
|
||||||
ExamUsersOccurrenceUpdated count@Int64: Termin/Raum für #{show count} Teilnehmer gesetzt
|
ExamUsersOccurrenceUpdated count@Int64: Termin/Raum für #{show count} Teilnehmer gesetzt
|
||||||
|
|
||||||
CsvFile: CSV-Datei
|
CsvFile: CSV-Datei
|
||||||
@ -1322,9 +1367,9 @@ CsvColumnExamUserSurname: Nachname(n) des Teilnehmers
|
|||||||
CsvColumnExamUserFirstName: Vorname(n) des Teilnehmers
|
CsvColumnExamUserFirstName: Vorname(n) des Teilnehmers
|
||||||
CsvColumnExamUserName: Voller Name des Teilnehmers (gewöhnlicherweise inkl. Vor- und Nachname(n))
|
CsvColumnExamUserName: Voller Name des Teilnehmers (gewöhnlicherweise inkl. Vor- und Nachname(n))
|
||||||
CsvColumnExamUserMatriculation: Matrikelnummer des Teilnehmers
|
CsvColumnExamUserMatriculation: Matrikelnummer des Teilnehmers
|
||||||
CsvColumnExamUserField: Hauptfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
|
CsvColumnExamUserField: Studienfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
|
||||||
CsvColumnExamUserDegree: Abschluss, den der Teilnehmer im assoziierten Hauptfach anstrebt
|
CsvColumnExamUserDegree: Abschluss, den der Teilnehmer im assoziierten Studienfach anstrebt
|
||||||
CsvColumnExamUserSemester: Fachsemester des Teilnehmers im assoziierten Hauptfach
|
CsvColumnExamUserSemester: Fachsemester des Teilnehmers im assoziierten Studienfach
|
||||||
CsvColumnExamUserOccurrence: Prüfungstermin/-Raum, zu dem der Teilnehmer angemeldet ist
|
CsvColumnExamUserOccurrence: Prüfungstermin/-Raum, zu dem der Teilnehmer angemeldet ist
|
||||||
CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb erreicht hat
|
CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb erreicht hat
|
||||||
CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Prüfungstermin erreichen hätte können
|
CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Prüfungstermin erreichen hätte können
|
||||||
@ -1344,14 +1389,14 @@ ExamUserCsvCourseRegister: Benutzer zum Kurs und zur Prüfung anmelden
|
|||||||
ExamUserCsvRegister: Kursteilnehmer zur Prüfung anmelden
|
ExamUserCsvRegister: Kursteilnehmer zur Prüfung anmelden
|
||||||
ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen
|
ExamUserCsvAssignOccurrence: Teilnehmern einen anderen Termin/Raum zuweisen
|
||||||
ExamUserCsvDeregister: Teilnehmer von der Prüfung abmelden
|
ExamUserCsvDeregister: Teilnehmer von der Prüfung abmelden
|
||||||
ExamUserCsvSetCourseField: Kurs-assoziiertes Hauptfach ändern
|
ExamUserCsvSetCourseField: Kurs-assoziiertes Studienfach ändern
|
||||||
ExamUserCsvSetResult: Ergebnis eintragen
|
ExamUserCsvSetResult: Ergebnis eintragen
|
||||||
ExamUserCsvSetCourseNote: Teilnehmer-Notizen anpassen
|
ExamUserCsvSetCourseNote: Teilnehmer-Notizen anpassen
|
||||||
|
|
||||||
ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht
|
ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht
|
||||||
|
|
||||||
ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identifiziert werden
|
ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identifiziert werden
|
||||||
ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Hauptfach des Kursteilnehmers zugeordnet werden
|
ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden
|
||||||
ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
|
ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
|
||||||
|
|
||||||
TableHeadingFilter: Filter
|
TableHeadingFilter: Filter
|
||||||
@ -1369,8 +1414,8 @@ BtnPasswordReset: Passwort zurücksetzen
|
|||||||
|
|
||||||
AuthLDAPLookupFailed: Nutzer konnte aufgrund eines LDAP-Fehlers nicht nachgeschlagen werden
|
AuthLDAPLookupFailed: Nutzer konnte aufgrund eines LDAP-Fehlers nicht nachgeschlagen werden
|
||||||
AuthLDAPInvalidLookup: Bestehender Nutzer konnte nicht eindeutig einem LDAP-Eintrag zugeordnet werden
|
AuthLDAPInvalidLookup: Bestehender Nutzer konnte nicht eindeutig einem LDAP-Eintrag zugeordnet werden
|
||||||
AuthLDAPAlreadyConfigured: Nutzer meldet sich bereits per Campus-Kennung an
|
AuthLDAPAlreadyConfigured: Nutzer meldet sich bereits per Campus-Kennung in Uni2work an
|
||||||
AuthLDAPConfigured: Nutzer meldet sich nun per Campus-Kennung an
|
AuthLDAPConfigured: Nutzer meldet sich nun per Campus-Kennung in Uni2work an
|
||||||
|
|
||||||
AuthPWHashAlreadyConfigured: Nutzer meldet sich bereits per Uni2work-Kennung an
|
AuthPWHashAlreadyConfigured: Nutzer meldet sich bereits per Uni2work-Kennung an
|
||||||
AuthPWHashConfigured: Nutzer meldet sich nun per Uni2work-Kennung an
|
AuthPWHashConfigured: Nutzer meldet sich nun per Uni2work-Kennung an
|
||||||
|
|||||||
@ -31,38 +31,14 @@ AllocationCourse
|
|||||||
allocation AllocationId
|
allocation AllocationId
|
||||||
course CourseId
|
course CourseId
|
||||||
minCapacity Int -- if the course would get assigned fewer than this many applicants, restart the assignment process without the course
|
minCapacity Int -- if the course would get assigned fewer than this many applicants, restart the assignment process without the course
|
||||||
instructions Html Maybe -- instructions from the lecturer to applicants
|
|
||||||
applicationText Bool -- lecturer will read application texts supplied by users
|
|
||||||
applicationFiles UploadMode -- lecturer wants to receive course specific application files
|
|
||||||
ratingsVisible Bool -- lecturer wants applicants to receive feedback on their application (Grade & comment)
|
|
||||||
UniqueAllocationCourse course
|
UniqueAllocationCourse course
|
||||||
|
|
||||||
AllocationCourseFile
|
|
||||||
allocationCourse AllocationCourseId
|
|
||||||
file FileId
|
|
||||||
UniqueAllocationCourseFile allocationCourse file
|
|
||||||
|
|
||||||
AllocationUser
|
AllocationUser
|
||||||
allocation AllocationId
|
allocation AllocationId
|
||||||
user UserId
|
user UserId
|
||||||
totalCourses Natural -- number of total allocated courses for this user must be <= than this number
|
totalCourses Natural -- number of total allocated courses for this user must be <= than this number
|
||||||
UniqueAllocationUser allocation user
|
UniqueAllocationUser allocation user
|
||||||
|
|
||||||
AllocationApplication
|
|
||||||
allocationCourse AllocationCourseId
|
|
||||||
allocationUser AllocationUserId
|
|
||||||
text Text Maybe -- free text entered by user
|
|
||||||
priority Natural -- priority, higher number means higher priority
|
|
||||||
ratingVeto Bool
|
|
||||||
ratingPoints ExamGrade Maybe
|
|
||||||
ratingComment Text Maybe
|
|
||||||
UniqueAllocationApplication allocationCourse allocationUser
|
|
||||||
|
|
||||||
AllocationApplicationFile -- supplemental file for application by a user for a certain course
|
|
||||||
application AllocationApplicationId
|
|
||||||
file FileId
|
|
||||||
UniqueAllocationUserFile application file
|
|
||||||
|
|
||||||
AllocationDeregister -- self-inflicted user-deregistrations from an allocated course
|
AllocationDeregister -- self-inflicted user-deregistrations from an allocated course
|
||||||
user UserId
|
user UserId
|
||||||
allocation AllocationId Maybe
|
allocation AllocationId Maybe
|
||||||
|
|||||||
@ -17,9 +17,20 @@ Course -- Information about a single course; contained info is always visible
|
|||||||
deregisterUntil UTCTime Maybe -- unenrolement may be prohibited from a given date onwards
|
deregisterUntil UTCTime Maybe -- unenrolement may be prohibited from a given date onwards
|
||||||
registerSecret Text Maybe -- enrolement maybe protected by a simple common passphrase
|
registerSecret Text Maybe -- enrolement maybe protected by a simple common passphrase
|
||||||
materialFree Bool -- False: only enrolled users may see course materials not stored in this table
|
materialFree Bool -- False: only enrolled users may see course materials not stored in this table
|
||||||
|
applicationsRequired Bool
|
||||||
|
applicationsInstructions Html Maybe
|
||||||
|
applicationsText Bool
|
||||||
|
applicationsFiles UploadMode
|
||||||
|
applicationsRatingsVisible Bool
|
||||||
TermSchoolCourseShort term school shorthand -- shorthand must be unique within school and semester
|
TermSchoolCourseShort term school shorthand -- shorthand must be unique within school and semester
|
||||||
TermSchoolCourseName term school name -- name must be unique within school and semester
|
TermSchoolCourseName term school name -- name must be unique within school and semester
|
||||||
deriving Generic
|
deriving Generic
|
||||||
|
|
||||||
|
CourseAppInstructionFile
|
||||||
|
course CourseId
|
||||||
|
file FileId
|
||||||
|
UniqueCourseAppInstructionFile course file
|
||||||
|
|
||||||
CourseEdit -- who edited when a row in table "Course", kept indefinitely (might be replaced by generic Audit Table; like all ...-Edit tables)
|
CourseEdit -- who edited when a row in table "Course", kept indefinitely (might be replaced by generic Audit Table; like all ...-Edit tables)
|
||||||
user UserId
|
user UserId
|
||||||
time UTCTime
|
time UTCTime
|
||||||
@ -59,3 +70,18 @@ CourseUserNoteEdit -- who edited a participants course note when
|
|||||||
user UserId
|
user UserId
|
||||||
time UTCTime
|
time UTCTime
|
||||||
note CourseUserNoteId -- PROBLEM: deleted notes have no modification date any more
|
note CourseUserNoteId -- PROBLEM: deleted notes have no modification date any more
|
||||||
|
|
||||||
|
CourseApplication
|
||||||
|
course CourseId
|
||||||
|
user UserId
|
||||||
|
field StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
|
||||||
|
text Text Maybe -- free text entered by user
|
||||||
|
ratingPoints ExamGrade Maybe
|
||||||
|
ratingComment Text Maybe
|
||||||
|
allocation AllocationId Maybe
|
||||||
|
allocationPriority Natural Maybe
|
||||||
|
time UTCTime default=now()
|
||||||
|
CourseApplicationFile
|
||||||
|
application CourseApplicationId
|
||||||
|
file FileId
|
||||||
|
UniqueApplicationFile application file
|
||||||
7
routes
7
routes
@ -86,7 +86,8 @@
|
|||||||
!/course/new CourseNewR GET POST !lecturer
|
!/course/new CourseNewR GET POST !lecturer
|
||||||
/course/#TermId/#SchoolId/#CourseShorthand CourseR !lecturer:
|
/course/#TermId/#SchoolId/#CourseShorthand CourseR !lecturer:
|
||||||
/ CShowR GET !free
|
/ CShowR GET !free
|
||||||
/register CRegisterR GET POST !timeANDcapacityANDallocation-time !lecturerANDallocation-time
|
/register CRegisterR GET POST !timeANDcapacityANDallocation-timeAND¬exam-result !lecturerANDallocation-time
|
||||||
|
/register-template CRegisterTemplateR GET !free
|
||||||
/edit CEditR GET POST
|
/edit CEditR GET POST
|
||||||
/lecturer-invite CLecInviteR GET POST
|
/lecturer-invite CLecInviteR GET POST
|
||||||
/delete CDeleteR GET POST !lecturerANDemptyANDallocation-time
|
/delete CDeleteR GET POST !lecturerANDemptyANDallocation-time
|
||||||
@ -152,7 +153,9 @@
|
|||||||
/users EUsersR GET POST
|
/users EUsersR GET POST
|
||||||
/users/new EAddUserR GET POST
|
/users/new EAddUserR GET POST
|
||||||
/users/invite EInviteR GET POST
|
/users/invite EInviteR GET POST
|
||||||
/register ERegisterR POST !timeANDcourse-registered !timeANDexam-registered
|
/register ERegisterR POST !timeANDcourse-registeredAND¬exam-registered !timeANDexam-registeredAND¬exam-result
|
||||||
|
/apps/#CryptoFileNameCourseApplication CourseApplicationR:
|
||||||
|
/files CAFilesR GET !self !lecturerANDtime
|
||||||
|
|
||||||
/subs CorrectionsR GET POST !corrector !lecturer
|
/subs CorrectionsR GET POST !corrector !lecturer
|
||||||
/subs/upload CorrectionsUploadR GET POST !corrector !lecturer
|
/subs/upload CorrectionsUploadR GET POST !corrector !lecturer
|
||||||
|
|||||||
@ -30,6 +30,24 @@ data Transaction
|
|||||||
{ transactionExam :: ExamId
|
{ transactionExam :: ExamId
|
||||||
, transactionUser :: UserId
|
, transactionUser :: UserId
|
||||||
}
|
}
|
||||||
|
| TransactionCourseParticipantEdit
|
||||||
|
{ transactionCourse :: CourseId
|
||||||
|
, transactionUser :: UserId
|
||||||
|
}
|
||||||
|
| TransactionCourseParticipantDeleted
|
||||||
|
{ transactionCourse :: CourseId
|
||||||
|
, transactionUser :: UserId
|
||||||
|
}
|
||||||
|
| TransactionCourseApplicationEdit
|
||||||
|
{ transactionCourse :: CourseId
|
||||||
|
, transactionUser :: UserId
|
||||||
|
, transactionCourseApplication :: CourseApplicationId
|
||||||
|
}
|
||||||
|
| TransactionCourseApplicationDeleted
|
||||||
|
{ transactionCourse :: CourseId
|
||||||
|
, transactionUser :: UserId
|
||||||
|
, transactionCourseApplication :: CourseApplicationId
|
||||||
|
}
|
||||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||||
|
|
||||||
deriveJSON defaultOptions
|
deriveJSON defaultOptions
|
||||||
|
|||||||
@ -29,6 +29,8 @@ import qualified Data.CaseInsensitive as CI
|
|||||||
import Data.Aeson (ToJSON(..), ToJSONKey(..), ToJSONKeyFunction(..), FromJSON(..), FromJSONKey(..), FromJSONKeyFunction(..), Value(..), withText)
|
import Data.Aeson (ToJSON(..), ToJSONKey(..), ToJSONKeyFunction(..), FromJSON(..), FromJSONKey(..), FromJSONKeyFunction(..), Value(..), withText)
|
||||||
import Data.Aeson.Encoding (text)
|
import Data.Aeson.Encoding (text)
|
||||||
|
|
||||||
|
import Text.Blaze (ToMarkup(..))
|
||||||
|
|
||||||
|
|
||||||
instance {-# OVERLAPPING #-} MonadThrow m => MonadCrypto (ReaderT CryptoIDKey m) where
|
instance {-# OVERLAPPING #-} MonadThrow m => MonadCrypto (ReaderT CryptoIDKey m) where
|
||||||
type MonadCryptoKey (ReaderT CryptoIDKey m) = CryptoIDKey
|
type MonadCryptoKey (ReaderT CryptoIDKey m) = CryptoIDKey
|
||||||
@ -46,19 +48,23 @@ decCryptoIDs [ ''SubmissionId
|
|||||||
, ''ExamOccurrenceId
|
, ''ExamOccurrenceId
|
||||||
, ''ExamPartId
|
, ''ExamPartId
|
||||||
, ''AllocationId
|
, ''AllocationId
|
||||||
|
, ''CourseApplicationId
|
||||||
]
|
]
|
||||||
|
|
||||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where
|
-- CryptoIDNamespace (CI FilePath) SubmissionId ~ "Submission"
|
||||||
|
instance {-# OVERLAPS #-} PathPiece (E.CryptoID "Submission" (CI FilePath)) where
|
||||||
fromPathPiece (Text.unpack -> piece) = do
|
fromPathPiece (Text.unpack -> piece) = do
|
||||||
piece' <- (stripPrefix `on` map CI.mk) "uwa" piece
|
piece' <- (stripPrefix `on` map CI.mk) "uwa" piece
|
||||||
return . CryptoID . CI.mk $ map CI.original piece'
|
return . CryptoID . CI.mk $ map CI.original piece'
|
||||||
toPathPiece = Text.pack . ("uwa" <>) . CI.foldedCase . ciphertext
|
toPathPiece = Text.pack . ("uwa" <>) . CI.foldedCase . ciphertext
|
||||||
|
|
||||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => ToJSON (E.CryptoID namespace (CI FilePath)) where
|
instance {-# OVERLAPS #-} ToJSON (E.CryptoID "Submission" (CI FilePath)) where
|
||||||
toJSON = String . toPathPiece
|
toJSON = String . toPathPiece
|
||||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => ToJSONKey (E.CryptoID namespace (CI FilePath)) where
|
instance {-# OVERLAPS #-} ToJSONKey (E.CryptoID "Submission" (CI FilePath)) where
|
||||||
toJSONKey = ToJSONKeyText toPathPiece (text . toPathPiece)
|
toJSONKey = ToJSONKeyText toPathPiece (text . toPathPiece)
|
||||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => FromJSON (E.CryptoID namespace (CI FilePath)) where
|
instance {-# OVERLAPS #-} FromJSON (E.CryptoID "Submission" (CI FilePath)) where
|
||||||
parseJSON = withText "CryptoFileNameSubmission" $ maybe (fail "Could not parse CryptoFileNameSubmission") return . fromPathPiece
|
parseJSON = withText "CryptoFileNameSubmission" $ maybe (fail "Could not parse CryptoFileNameSubmission") return . fromPathPiece
|
||||||
instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => FromJSONKey (E.CryptoID namespace (CI FilePath)) where
|
instance {-# OVERLAPS #-} FromJSONKey (E.CryptoID "Submission" (CI FilePath)) where
|
||||||
fromJSONKey = FromJSONKeyTextParser $ maybe (fail "Could not parse CryptoFileNameSubmission") return . fromPathPiece
|
fromJSONKey = FromJSONKeyTextParser $ maybe (fail "Could not parse CryptoFileNameSubmission") return . fromPathPiece
|
||||||
|
instance {-# OVERLAPS #-} ToMarkup (E.CryptoID "Submission" (CI FilePath)) where
|
||||||
|
toMarkup = toMarkup . toPathPiece
|
||||||
|
|||||||
@ -10,5 +10,11 @@ import Text.Blaze (ToMarkup(..))
|
|||||||
|
|
||||||
import ClassyPrelude
|
import ClassyPrelude
|
||||||
|
|
||||||
|
import Data.CaseInsensitive (CI)
|
||||||
|
import qualified Data.CaseInsensitive as CI
|
||||||
|
|
||||||
|
instance {-# OVERLAPS #-} ToMarkup s => ToMarkup (CID.CryptoID c (CI s)) where
|
||||||
|
toMarkup = toMarkup . CI.foldedCase . CID.ciphertext
|
||||||
|
|
||||||
instance ToMarkup s => ToMarkup (CID.CryptoID c s) where
|
instance ToMarkup s => ToMarkup (CID.CryptoID c s) where
|
||||||
toMarkup = toMarkup . CID.ciphertext
|
toMarkup = toMarkup . CID.ciphertext
|
||||||
@ -54,6 +54,7 @@ import Data.Conduit (($$))
|
|||||||
import Data.Conduit.List (sourceList)
|
import Data.Conduit.List (sourceList)
|
||||||
|
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
|
import qualified Database.Esqueleto.Utils as E
|
||||||
|
|
||||||
import Control.Monad.Except (MonadError(..), ExceptT)
|
import Control.Monad.Except (MonadError(..), ExceptT)
|
||||||
import Control.Monad.Trans.Maybe (MaybeT(..))
|
import Control.Monad.Trans.Maybe (MaybeT(..))
|
||||||
@ -179,6 +180,10 @@ pattern CSubmissionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Cr
|
|||||||
pattern CSubmissionR tid ssh csh shn cid ptn
|
pattern CSubmissionR tid ssh csh shn cid ptn
|
||||||
= CSheetR tid ssh csh shn (SubmissionR cid ptn)
|
= CSheetR tid ssh csh shn (SubmissionR cid ptn)
|
||||||
|
|
||||||
|
pattern CApplicationR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> CourseApplicationR -> Route UniWorX
|
||||||
|
pattern CApplicationR tid ssh csh appId ptn
|
||||||
|
= CourseR tid ssh csh (CourseApplicationR appId ptn)
|
||||||
|
|
||||||
|
|
||||||
pluralDE :: (Eq a, Num a)
|
pluralDE :: (Eq a, Num a)
|
||||||
=> a -- ^ Count
|
=> a -- ^ Count
|
||||||
@ -282,6 +287,7 @@ embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>)
|
|||||||
embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
|
embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
|
||||||
embedRenderMessage ''UniWorX ''StudyFieldType id
|
embedRenderMessage ''UniWorX ''StudyFieldType id
|
||||||
embedRenderMessage ''UniWorX ''SheetFileType id
|
embedRenderMessage ''UniWorX ''SheetFileType id
|
||||||
|
embedRenderMessage ''UniWorX ''SubmissionFileType id
|
||||||
embedRenderMessage ''UniWorX ''CorrectorState id
|
embedRenderMessage ''UniWorX ''CorrectorState id
|
||||||
embedRenderMessage ''UniWorX ''RatingException id
|
embedRenderMessage ''UniWorX ''RatingException id
|
||||||
embedRenderMessage ''UniWorX ''SubmissionSinkException ("SubmissionSinkException" <>)
|
embedRenderMessage ''UniWorX ''SubmissionSinkException ("SubmissionSinkException" <>)
|
||||||
@ -518,6 +524,11 @@ andAR _ _ reason@(Unauthorized _) = reason
|
|||||||
andAR _ Authorized other = other
|
andAR _ Authorized other = other
|
||||||
andAR _ AuthenticationRequired _ = AuthenticationRequired
|
andAR _ AuthenticationRequired _ = AuthenticationRequired
|
||||||
|
|
||||||
|
notAR :: RenderMessage UniWorX msg => MsgRenderer -> msg -> AuthResult -> AuthResult
|
||||||
|
notAR _ _ (Unauthorized _) = Authorized
|
||||||
|
notAR _ _ AuthenticationRequired = AuthenticationRequired
|
||||||
|
notAR mr msg Authorized = Unauthorized . render mr . MsgUnauthorizedNot $ render mr msg
|
||||||
|
|
||||||
trueAR, falseAR :: MsgRendererS UniWorX -> AuthResult
|
trueAR, falseAR :: MsgRendererS UniWorX -> AuthResult
|
||||||
trueAR = const Authorized
|
trueAR = const Authorized
|
||||||
falseAR = Unauthorized . ($ MsgUnauthorized) . render
|
falseAR = Unauthorized . ($ MsgUnauthorized) . render
|
||||||
@ -580,14 +591,13 @@ tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of
|
|||||||
-- Courses: access only to school admins
|
-- Courses: access only to school admins
|
||||||
CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
|
CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` userAdmin) -> do
|
isAdmin <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` userAdmin) -> do
|
||||||
E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserAdminSchool
|
E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserAdminSchool
|
||||||
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val authId
|
E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val authId
|
||||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
|
||||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedSchoolAdmin)
|
|
||||||
return Authorized
|
return Authorized
|
||||||
-- other routes: access to any admin is granted here
|
-- other routes: access to any admin is granted here
|
||||||
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||||
@ -622,14 +632,13 @@ tagAccessPredicate AuthDevelopment = APHandler $ \_ r _ -> do
|
|||||||
tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
|
tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
|
||||||
CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
|
CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
[E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` lecturer) -> do
|
isLecturer <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` lecturer) -> do
|
||||||
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
|
||||||
E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
|
E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
|
||||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
|
||||||
guardMExceptT (c>0) (unauthorizedI MsgUnauthorizedLecturer)
|
|
||||||
return Authorized
|
return Authorized
|
||||||
-- lecturer for any school will do
|
-- lecturer for any school will do
|
||||||
_ -> $cachedHereBinary mAuthId . exceptT return return $ do
|
_ -> $cachedHereBinary mAuthId . exceptT return return $ do
|
||||||
@ -688,6 +697,22 @@ tagAccessPredicate AuthTutor = APDB $ \mAuthId route _ -> exceptT return return
|
|||||||
guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedTutor)
|
guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedTutor)
|
||||||
return Authorized
|
return Authorized
|
||||||
tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
||||||
|
CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
|
||||||
|
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||||
|
allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
|
||||||
|
allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
|
||||||
|
|
||||||
|
case allocation of
|
||||||
|
Nothing -> return ()
|
||||||
|
Just Allocation{..} -> do
|
||||||
|
cTime <- liftIO getCurrentTime
|
||||||
|
guard $ NTop allocationStaffAllocationFrom <= NTop (Just cTime)
|
||||||
|
guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
|
||||||
|
|
||||||
|
return Authorized
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do
|
CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do
|
||||||
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||||
Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
|
Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
|
||||||
@ -781,9 +806,20 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
|
|||||||
| not registered
|
| not registered
|
||||||
, maybe False (now >=) courseRegisterFrom -- Nothing => no registration allowed
|
, maybe False (now >=) courseRegisterFrom -- Nothing => no registration allowed
|
||||||
, maybe True (now <=) courseRegisterTo -> return Authorized
|
, maybe True (now <=) courseRegisterTo -> return Authorized
|
||||||
(Just (Entity _ Course{courseDeregisterUntil}))
|
(Just (Entity cid Course{courseDeregisterUntil}))
|
||||||
| registered
|
| registered
|
||||||
, maybe True (now <=) courseDeregisterUntil -> return Authorized
|
-> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do
|
||||||
|
guard $ maybe True (now <=) courseDeregisterUntil
|
||||||
|
forM_ mAuthId $ \uid -> do
|
||||||
|
exams <- lift . E.select . E.from $ \exam -> do
|
||||||
|
E.where_ . E.exists . E.from $ \examRegistration ->
|
||||||
|
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||||
|
E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
|
||||||
|
E.where_ $ exam E.^. ExamCourse E.==. E.val cid
|
||||||
|
return $ exam E.^. ExamDeregisterUntil
|
||||||
|
forM_ exams $ \(E.Value deregUntil) ->
|
||||||
|
guard $ NTop (Just now) >= NTop deregUntil
|
||||||
|
return Authorized
|
||||||
_other -> unauthorizedI MsgUnauthorizedCourseTime
|
_other -> unauthorizedI MsgUnauthorizedCourseTime
|
||||||
|
|
||||||
MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
|
MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
|
||||||
@ -844,20 +880,19 @@ tagAccessPredicate AuthAllocationTime = APDB $ \mAuthId route _ -> case route of
|
|||||||
tagAccessPredicate AuthCourseRegistered = APDB $ \mAuthId route _ -> case route of
|
tagAccessPredicate AuthCourseRegistered = APDB $ \mAuthId route _ -> case route of
|
||||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
[E.Value c] <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.select . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
|
isRegistered <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` courseParticipant) -> do
|
||||||
E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
|
E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
|
||||||
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val authId
|
E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val authId
|
||||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
guardMExceptT isRegistered (unauthorizedI MsgUnauthorizedRegistered)
|
||||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
|
|
||||||
return Authorized
|
return Authorized
|
||||||
r -> $unsupportedAuthPredicate AuthCourseRegistered r
|
r -> $unsupportedAuthPredicate AuthCourseRegistered r
|
||||||
tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case route of
|
tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case route of
|
||||||
CTutorialR tid ssh csh tutn _ -> exceptT return return $ do
|
CTutorialR tid ssh csh tutn _ -> exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
[E.Value c] <- $cachedHereBinary (authId, tid, ssh, csh, tutn) . lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do
|
isRegistered <- $cachedHereBinary (authId, tid, ssh, csh, tutn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do
|
||||||
E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
|
E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
|
||||||
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
|
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
|
||||||
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. E.val authId
|
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. E.val authId
|
||||||
@ -865,26 +900,24 @@ tagAccessPredicate AuthTutorialRegistered = APDB $ \mAuthId route _ -> case rout
|
|||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
E.&&. tutorial E.^. TutorialName E.==. E.val tutn
|
E.&&. tutorial E.^. TutorialName E.==. E.val tutn
|
||||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
guardMExceptT isRegistered (unauthorizedI MsgUnauthorizedRegistered)
|
||||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
|
|
||||||
return Authorized
|
return Authorized
|
||||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
[E.Value c] <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.select . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do
|
isRegistered <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` tutorial `E.InnerJoin` tutorialParticipant) -> do
|
||||||
E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
|
E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
|
||||||
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
|
E.on $ course E.^. CourseId E.==. tutorial E.^. TutorialCourse
|
||||||
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. E.val authId
|
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. E.val authId
|
||||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
guardMExceptT isRegistered (unauthorizedI MsgUnauthorizedRegistered)
|
||||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
|
|
||||||
return Authorized
|
return Authorized
|
||||||
r -> $unsupportedAuthPredicate AuthTutorialRegistered r
|
r -> $unsupportedAuthPredicate AuthTutorialRegistered r
|
||||||
tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of
|
tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of
|
||||||
CExamR tid ssh csh examn _ -> exceptT return return $ do
|
CExamR tid ssh csh examn _ -> exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
[E.Value c] <- $cachedHereBinary (authId, tid, ssh, csh, examn) . lift . E.select . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
|
hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh, examn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
|
||||||
E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
|
E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
|
||||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
|
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
|
||||||
@ -892,20 +925,47 @@ tagAccessPredicate AuthExamRegistered = APDB $ \mAuthId route _ -> case route of
|
|||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
E.&&. exam E.^. ExamName E.==. E.val examn
|
E.&&. exam E.^. ExamName E.==. E.val examn
|
||||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
|
||||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
|
|
||||||
return Authorized
|
return Authorized
|
||||||
CourseR tid ssh csh _ -> exceptT return return $ do
|
CourseR tid ssh csh _ -> exceptT return return $ do
|
||||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
[E.Value c] <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.select . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
|
hasRegistration <- $cachedHereBinary (authId, tid, ssh, csh) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` examRegistration) -> do
|
||||||
E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
|
E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
|
||||||
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
|
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val authId
|
||||||
E.&&. course E.^. CourseTerm E.==. E.val tid
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
guardMExceptT hasRegistration (unauthorizedI MsgUnauthorizedRegistered)
|
||||||
guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedRegistered)
|
return Authorized
|
||||||
|
r -> $unsupportedAuthPredicate AuthExamRegistered r
|
||||||
|
tagAccessPredicate AuthExamResult = APDB $ \mAuthId route _ -> case route of
|
||||||
|
CExamR tid ssh csh examn _ -> exceptT return return $ do
|
||||||
|
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||||
|
hasResult <- $cachedHereBinary (authId, tid, ssh, csh, examn) . lift . E.selectExists . E.from $ \(course `E.InnerJoin` exam `E.InnerJoin` (examResult `E.FullOuterJoin` (examPartResult `E.InnerJoin` examPart))) -> do
|
||||||
|
E.on $ examPartResult E.?. ExamPartResultExamPart E.==. examPart E.?. ExamPartId
|
||||||
|
E.on $ examResult E.?. ExamResultExam E.==. examPart E.?. ExamPartExam
|
||||||
|
E.on $ E.just (exam E.^. ExamId) E.==. examResult E.?. ExamResultExam
|
||||||
|
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||||
|
E.where_ $ (examResult E.?. ExamResultUser E.==. E.just (E.val authId) E.||. examPartResult E.?. ExamPartResultUser E.==. E.just (E.val authId))
|
||||||
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||||
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
|
E.&&. exam E.^. ExamName E.==. E.val examn
|
||||||
|
guardMExceptT hasResult (unauthorizedI MsgUnauthorizedExamResult)
|
||||||
|
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 `E.FullOuterJoin` (examPartResult `E.InnerJoin` examPart))) -> do
|
||||||
|
E.on $ examPartResult E.?. ExamPartResultExamPart E.==. examPart E.?. ExamPartId
|
||||||
|
E.on $ examResult E.?. ExamResultExam E.==. examPart E.?. ExamPartExam
|
||||||
|
E.on $ E.just (exam E.^. ExamId) E.==. examResult E.?. ExamResultExam
|
||||||
|
E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
|
||||||
|
E.where_ $ (examResult E.?. ExamResultUser E.==. E.just (E.val authId) E.||. examPartResult E.?. ExamPartResultUser E.==. E.just (E.val authId))
|
||||||
|
E.&&. course E.^. CourseTerm E.==. E.val tid
|
||||||
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
|
guardMExceptT hasResult (unauthorizedI MsgUnauthorizedExamResult)
|
||||||
return Authorized
|
return Authorized
|
||||||
r -> $unsupportedAuthPredicate AuthExamRegistered r
|
r -> $unsupportedAuthPredicate AuthExamRegistered r
|
||||||
tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
|
tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
|
||||||
@ -1004,10 +1064,9 @@ tagAccessPredicate AuthEmpty = APDB $ \_ route _ -> case route of
|
|||||||
-- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
|
-- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
|
||||||
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
|
||||||
assertM_ (<= 0) . $cachedHereBinary cid . lift $ count [ CourseParticipantCourse ==. cid ]
|
assertM_ (<= 0) . $cachedHereBinary cid . lift $ count [ CourseParticipantCourse ==. cid ]
|
||||||
assertM_ ((<= 0) :: Int -> Bool) . $cachedHereBinary cid . lift . fmap (E.unValue . unsafeHead) $ E.select . E.from $ \(sheet `E.InnerJoin` submission) -> do
|
assertM_ not . $cachedHereBinary cid . lift $ E.selectExists . E.from $ \(sheet `E.InnerJoin` submission) -> do
|
||||||
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
|
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
|
||||||
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
|
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
|
||||||
return E.countRows
|
|
||||||
return Authorized
|
return Authorized
|
||||||
r -> $unsupportedAuthPredicate AuthEmpty r
|
r -> $unsupportedAuthPredicate AuthEmpty r
|
||||||
tagAccessPredicate AuthMaterials = APDB $ \_ route _ -> case route of
|
tagAccessPredicate AuthMaterials = APDB $ \_ route _ -> case route of
|
||||||
@ -1044,19 +1103,24 @@ tagAccessPredicate AuthCorrectorSubmissions = APDB $ \_ route _ -> case route of
|
|||||||
guard submissionModeCorrector
|
guard submissionModeCorrector
|
||||||
return Authorized
|
return Authorized
|
||||||
r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
|
r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
|
||||||
tagAccessPredicate AuthSelf = APHandler $ \mAuthId route _ -> exceptT return return $ do
|
tagAccessPredicate AuthSelf = APDB $ \mAuthId route _ -> exceptT return return $ do
|
||||||
referencedUser <- case route of
|
referencedUser <- case route of
|
||||||
AdminUserR cID -> return cID
|
AdminUserR cID -> decrypt cID
|
||||||
AdminUserDeleteR cID -> return cID
|
AdminUserDeleteR cID -> decrypt cID
|
||||||
AdminHijackUserR cID -> return cID
|
AdminHijackUserR cID -> decrypt cID
|
||||||
UserNotificationR cID -> return cID
|
UserNotificationR cID -> decrypt cID
|
||||||
UserPasswordR cID -> return cID
|
UserPasswordR cID -> decrypt cID
|
||||||
CourseR _ _ _ (CUserR cID) -> return cID
|
CourseR _ _ _ (CUserR cID) -> decrypt cID
|
||||||
|
CApplicationR _ _ _ cID _ -> do
|
||||||
|
appId <- decrypt cID
|
||||||
|
application <- $cachedHereBinary appId . lift $ get appId
|
||||||
|
case application of
|
||||||
|
Nothing -> throwError =<< unauthorizedI MsgUnauthorizedSelf
|
||||||
|
Just CourseApplication{..} -> return courseApplicationUser
|
||||||
_other -> throwError =<< $unsupportedAuthPredicate AuthSelf route
|
_other -> throwError =<< $unsupportedAuthPredicate AuthSelf route
|
||||||
referencedUser' <- decrypt referencedUser
|
|
||||||
case mAuthId of
|
case mAuthId of
|
||||||
Just uid
|
Just uid
|
||||||
| uid == referencedUser' -> return Authorized
|
| uid == referencedUser -> return Authorized
|
||||||
Nothing -> return AuthenticationRequired
|
Nothing -> return AuthenticationRequired
|
||||||
_other -> unauthorizedI MsgUnauthorizedSelf
|
_other -> unauthorizedI MsgUnauthorizedSelf
|
||||||
tagAccessPredicate AuthIsLDAP = APDB $ \_ route _ -> exceptT return return $ do
|
tagAccessPredicate AuthIsLDAP = APDB $ \_ route _ -> exceptT return return $ do
|
||||||
@ -1159,10 +1223,7 @@ evalAuthTags AuthTagActive{..} (map (Set.toList . toNullable) . Set.toList . dnf
|
|||||||
|
|
||||||
evalAuthLiteral :: AuthLiteral -> WriterT (Set AuthTag) m AuthResult
|
evalAuthLiteral :: AuthLiteral -> WriterT (Set AuthTag) m AuthResult
|
||||||
evalAuthLiteral PLVariable{..} = evalAuthTag plVar
|
evalAuthLiteral PLVariable{..} = evalAuthTag plVar
|
||||||
evalAuthLiteral PLNegated{..} = evalAuthTag plVar >>= \case
|
evalAuthLiteral PLNegated{..} = notAR mr plVar <$> evalAuthTag plVar
|
||||||
Unauthorized _ -> return Authorized
|
|
||||||
AuthenticationRequired -> return AuthenticationRequired
|
|
||||||
Authorized -> unauthorizedI plVar
|
|
||||||
|
|
||||||
orAR', andAR' :: forall m'. Monad m' => m' AuthResult -> m' AuthResult -> m' AuthResult
|
orAR', andAR' :: forall m'. Monad m' => m' AuthResult -> m' AuthResult -> m' AuthResult
|
||||||
orAR' = shortCircuitM (is _Authorized) (orAR mr)
|
orAR' = shortCircuitM (is _Authorized) (orAR mr)
|
||||||
@ -2731,6 +2792,7 @@ routeNormalizers =
|
|||||||
, ncCourse
|
, ncCourse
|
||||||
, ncSheet
|
, ncSheet
|
||||||
, verifySubmission
|
, verifySubmission
|
||||||
|
, verifyCourseApplication
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
normalizeRender route = route <$ do
|
normalizeRender route = route <$ do
|
||||||
@ -2777,6 +2839,14 @@ routeNormalizers =
|
|||||||
let newRoute = CSubmissionR courseTerm courseSchool courseShorthand sheetName cID sr
|
let newRoute = CSubmissionR courseTerm courseSchool courseShorthand sheetName cID sr
|
||||||
tell . Any $ route /= newRoute
|
tell . Any $ route /= newRoute
|
||||||
return newRoute
|
return newRoute
|
||||||
|
verifyCourseApplication = maybeOrig $ \route -> do
|
||||||
|
CApplicationR _tid _ssh _csh cID sr <- return route
|
||||||
|
aId <- decrypt cID
|
||||||
|
CourseApplication{courseApplicationCourse} <- lift . lift $ get404 aId
|
||||||
|
Course{courseTerm, courseSchool, courseShorthand} <- lift . lift $ get404 courseApplicationCourse
|
||||||
|
let newRoute = CApplicationR courseTerm courseSchool courseShorthand cID sr
|
||||||
|
tell . Any $ route /= newRoute
|
||||||
|
return newRoute
|
||||||
|
|
||||||
|
|
||||||
-- How to run database actions.
|
-- How to run database actions.
|
||||||
|
|||||||
@ -15,6 +15,7 @@ import Handler.Course.Register as Handler.Course
|
|||||||
import Handler.Course.Show as Handler.Course
|
import Handler.Course.Show as Handler.Course
|
||||||
import Handler.Course.User as Handler.Course
|
import Handler.Course.User as Handler.Course
|
||||||
import Handler.Course.Users as Handler.Course
|
import Handler.Course.Users as Handler.Course
|
||||||
|
import Handler.Course.Application as Handler.Course
|
||||||
|
|
||||||
|
|
||||||
getCHiWisR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
getCHiWisR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||||
|
|||||||
37
src/Handler/Course/Application.hs
Normal file
37
src/Handler/Course/Application.hs
Normal file
@ -0,0 +1,37 @@
|
|||||||
|
module Handler.Course.Application
|
||||||
|
( getCAFilesR
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
import Handler.Utils
|
||||||
|
|
||||||
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
|
import System.FilePath (addExtension)
|
||||||
|
|
||||||
|
import qualified Data.Conduit.List as C
|
||||||
|
|
||||||
|
|
||||||
|
getCAFilesR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler TypedContent
|
||||||
|
getCAFilesR tid ssh csh cID = do
|
||||||
|
appId <- decrypt cID
|
||||||
|
User{..} <- runDB $ do
|
||||||
|
CourseApplication{..} <- get404 appId
|
||||||
|
Course{..} <- get404 courseApplicationCourse
|
||||||
|
let matches = and
|
||||||
|
[ tid == courseTerm
|
||||||
|
, ssh == courseSchool
|
||||||
|
, csh == courseShorthand
|
||||||
|
]
|
||||||
|
unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
|
||||||
|
get404 courseApplicationUser
|
||||||
|
|
||||||
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgCourseApplicationArchiveName tid ssh csh cID userDisplayName
|
||||||
|
let
|
||||||
|
fsSource = E.selectSource . E.from $ \(courseApplicationFile `E.InnerJoin` file) -> do
|
||||||
|
E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file E.^. FileId
|
||||||
|
E.where_ $ courseApplicationFile E.^. CourseApplicationFileApplication E.==. E.val appId
|
||||||
|
return file
|
||||||
|
|
||||||
|
serveSomeFiles archiveName $ fsSource .| C.map entityVal
|
||||||
@ -41,6 +41,12 @@ data CourseForm = CourseForm
|
|||||||
, cfLink :: Maybe Text
|
, cfLink :: Maybe Text
|
||||||
, cfMatFree :: Bool
|
, cfMatFree :: Bool
|
||||||
, cfAllocation :: Maybe AllocationCourseForm
|
, cfAllocation :: Maybe AllocationCourseForm
|
||||||
|
, cfAppRequired :: Bool
|
||||||
|
, cfAppInstructions :: Maybe Html
|
||||||
|
, cfAppInstructionFiles :: Maybe (Source Handler (Either FileId File))
|
||||||
|
, cfAppText :: Bool
|
||||||
|
, cfAppFiles :: UploadMode
|
||||||
|
, cfAppRatingsVisible :: Bool
|
||||||
, cfCapacity :: Maybe Int
|
, cfCapacity :: Maybe Int
|
||||||
, cfSecret :: Maybe Text
|
, cfSecret :: Maybe Text
|
||||||
, cfRegFrom :: Maybe UTCTime
|
, cfRegFrom :: Maybe UTCTime
|
||||||
@ -51,43 +57,45 @@ data CourseForm = CourseForm
|
|||||||
|
|
||||||
data AllocationCourseForm = AllocationCourseForm
|
data AllocationCourseForm = AllocationCourseForm
|
||||||
{ acfAllocation :: AllocationId
|
{ acfAllocation :: AllocationId
|
||||||
, acfInstructions :: Maybe Html
|
|
||||||
, acfFiles :: Maybe (Source Handler (Either FileId File))
|
|
||||||
, acfApplicationText :: Bool
|
|
||||||
, acfApplicationFiles :: UploadMode
|
|
||||||
, acfApplicationRatingsVisible :: Bool
|
|
||||||
, acfMinCapacity :: Int
|
, acfMinCapacity :: Int
|
||||||
}
|
}
|
||||||
|
|
||||||
courseToForm :: Entity Course -> [Lecturer] -> [(UserEmail, InvitationDBData Lecturer)] -> Maybe (Entity AllocationCourse) -> CourseForm
|
courseToForm :: Entity Course -> [Lecturer] -> [(UserEmail, InvitationDBData Lecturer)] -> Maybe (Entity AllocationCourse) -> CourseForm
|
||||||
courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||||
{ cfCourseId = Just cid
|
{ cfCourseId = Just cid
|
||||||
, cfName = courseName
|
, cfName = courseName
|
||||||
, cfDesc = courseDescription
|
, cfDesc = courseDescription
|
||||||
, cfLink = courseLinkExternal
|
, cfLink = courseLinkExternal
|
||||||
, cfShort = courseShorthand
|
, cfShort = courseShorthand
|
||||||
, cfTerm = courseTerm
|
, cfTerm = courseTerm
|
||||||
, cfSchool = courseSchool
|
, cfSchool = courseSchool
|
||||||
, cfCapacity = courseCapacity
|
, cfCapacity = courseCapacity
|
||||||
, cfSecret = courseRegisterSecret
|
, cfSecret = courseRegisterSecret
|
||||||
, cfMatFree = courseMaterialFree
|
, cfMatFree = courseMaterialFree
|
||||||
, cfRegFrom = courseRegisterFrom
|
, cfAllocation = allocationCourseToForm <$> alloc
|
||||||
, cfRegTo = courseRegisterTo
|
, cfAppRequired = courseApplicationsRequired
|
||||||
, cfDeRegUntil = courseDeregisterUntil
|
, cfAppInstructions = courseApplicationsInstructions
|
||||||
, cfAllocation = allocationCourseToForm <$> alloc
|
, cfAppInstructionFiles
|
||||||
, cfLecturers = [Right (lecturerUser, lecturerType) | Lecturer{..} <- lecs]
|
, cfAppText = courseApplicationsText
|
||||||
++ [Left (email, mType) | (email, InvDBDataLecturer mType) <- lecInvites ]
|
, cfAppFiles = courseApplicationsFiles
|
||||||
|
, cfAppRatingsVisible = courseApplicationsRatingsVisible
|
||||||
|
, cfRegFrom = courseRegisterFrom
|
||||||
|
, cfRegTo = courseRegisterTo
|
||||||
|
, cfDeRegUntil = courseDeregisterUntil
|
||||||
|
, cfLecturers = [Right (lecturerUser, lecturerType) | Lecturer{..} <- lecs]
|
||||||
|
++ [Left (email, mType) | (email, InvDBDataLecturer mType) <- lecInvites ]
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
cfAppInstructionFiles = Just . transPipe runDB $ selectAppFiles .| C.map (Left . E.unValue)
|
||||||
|
where selectAppFiles = E.selectSource . E.from $ \courseAppInstructionFile -> do
|
||||||
|
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. E.val cid
|
||||||
|
return $ courseAppInstructionFile E.^. CourseAppInstructionFileFile
|
||||||
|
|
||||||
|
|
||||||
allocationCourseToForm :: Entity AllocationCourse -> AllocationCourseForm
|
allocationCourseToForm :: Entity AllocationCourse -> AllocationCourseForm
|
||||||
allocationCourseToForm (Entity _ AllocationCourse{..}) = AllocationCourseForm
|
allocationCourseToForm (Entity _ AllocationCourse{..}) = AllocationCourseForm
|
||||||
{ acfAllocation = allocationCourseAllocation
|
{ acfAllocation = allocationCourseAllocation
|
||||||
, acfMinCapacity = allocationCourseMinCapacity
|
, acfMinCapacity = allocationCourseMinCapacity
|
||||||
, acfInstructions = allocationCourseInstructions
|
|
||||||
, acfFiles = Nothing
|
|
||||||
, acfApplicationText = allocationCourseApplicationText
|
|
||||||
, acfApplicationFiles = allocationCourseApplicationFiles
|
|
||||||
, acfApplicationRatingsVisible = allocationCourseRatingsVisible
|
|
||||||
}
|
}
|
||||||
|
|
||||||
makeCourseForm :: (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> Maybe CourseForm -> Form CourseForm
|
makeCourseForm :: (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> Maybe CourseForm -> Form CourseForm
|
||||||
@ -213,21 +221,9 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
|
|||||||
_ -> do
|
_ -> do
|
||||||
allocationOptions <- mkOptionList <$> mapM mkAllocationOption availableAllocations
|
allocationOptions <- mkOptionList <$> mapM mkAllocationOption availableAllocations
|
||||||
|
|
||||||
oldFileIds <- for ((,) <$> (fmap acfAllocation $ template >>= cfAllocation) <*> (template >>= cfCourseId)) $ \(allId, cId) -> fmap (Set.fromList . map E.unValue) . liftHandlerT . runDB . E.select . E.from $ \(allocationCourseFile `E.InnerJoin` allocationCourse) -> do
|
|
||||||
E.on $ allocationCourseFile E.^. AllocationCourseFileAllocationCourse E.==. allocationCourse E.^. AllocationCourseId
|
|
||||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. E.val cId
|
|
||||||
E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val allId
|
|
||||||
return $ allocationCourseFile E.^. AllocationCourseFileFile
|
|
||||||
|
|
||||||
|
|
||||||
let
|
let
|
||||||
allocationForm' = AllocationCourseForm
|
allocationForm' = AllocationCourseForm
|
||||||
<$> apreq (selectField' Nothing $ return allocationOptions) (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation)
|
<$> apreq (selectField' Nothing $ return allocationOptions) (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation)
|
||||||
<*> (assertM (not . null . renderHtml) <$> aopt htmlField (fslI MsgCourseAllocationInstructions & setTooltip MsgCourseAllocationInstructionsTip) (fmap acfInstructions $ template >>= cfAllocation))
|
|
||||||
<*> aopt (multiFileField . return $ fromMaybe Set.empty oldFileIds) (fslI MsgCourseAllocationApplicationTemplate) (fmap acfFiles $ template >>= cfAllocation)
|
|
||||||
<*> apopt checkBoxField (fslI MsgCourseAllocationApplicationText & setTooltip MsgCourseAllocationApplicationTextTip) (fmap acfApplicationText $ template >>= cfAllocation)
|
|
||||||
<*> uploadModeForm (fmap acfApplicationFiles $ template >>= cfAllocation)
|
|
||||||
<*> apopt checkBoxField (fslI MsgCourseAllocationApplicationRatingsVisible & setTooltip MsgCourseAllocationApplicationRatingsVisibleTip) (fmap acfApplicationRatingsVisible $ template >>= cfAllocation)
|
|
||||||
<*> apreq (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation)
|
<*> apreq (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation)
|
||||||
|
|
||||||
optionalActionW allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template)
|
optionalActionW allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template)
|
||||||
@ -247,6 +243,12 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
|
|||||||
<*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template)
|
<*> apopt checkBoxField (fslI MsgMaterialFree) (cfMatFree <$> template)
|
||||||
<* aformSection MsgCourseFormSectionRegistration
|
<* aformSection MsgCourseFormSectionRegistration
|
||||||
<*> allocationForm
|
<*> allocationForm
|
||||||
|
<*> apopt checkBoxField (fslI MsgCourseApplicationRequired & setTooltip MsgCourseApplicationRequiredTip) (cfAppRequired <$> template)
|
||||||
|
<*> (assertM (not . null . renderHtml) <$> aopt htmlField (fslI MsgCourseApplicationInstructions & setTooltip MsgCourseApplicationInstructionsTip) (cfAppInstructions <$> template))
|
||||||
|
<*> aopt (multiFileField' . fromMaybe (return ()) $ cfAppInstructionFiles =<< template) (fslI MsgCourseApplicationTemplate & setTooltip MsgCourseApplicationTemplateTip) (cfAppInstructionFiles <$> template)
|
||||||
|
<*> apopt checkBoxField (fslI MsgCourseApplicationsText & setTooltip MsgCourseApplicationsTextTip) (cfAppText <$> template)
|
||||||
|
<*> uploadModeForm (cfAppFiles <$> template)
|
||||||
|
<*> apopt checkBoxField (fslI MsgCourseApplicationRatingsVisible & setTooltip MsgCourseApplicationRatingsVisibleTip) (cfAppRatingsVisible <$> template)
|
||||||
<*> aopt (natFieldI MsgCourseCapacity) (fslI MsgCourseCapacity
|
<*> aopt (natFieldI MsgCourseCapacity) (fslI MsgCourseCapacity
|
||||||
& setTooltip MsgCourseCapacityTip) (cfCapacity <$> template)
|
& setTooltip MsgCourseCapacityTip) (cfCapacity <$> template)
|
||||||
<*> aopt textField (fslpI MsgCourseSecret (mr MsgCourseSecretFormat)
|
<*> aopt textField (fslpI MsgCourseSecret (mr MsgCourseSecretFormat)
|
||||||
@ -425,20 +427,26 @@ courseEditHandler miButtonAction mbCourseForm = do
|
|||||||
} -> do -- create new course
|
} -> do -- create new course
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
insertOkay <- runDBJobs $ do
|
insertOkay <- runDBJobs $ do
|
||||||
insertOkay <- insertUnique Course
|
insertOkay <- let CourseForm{..} = res
|
||||||
{ courseName = cfName res
|
in insertUnique Course
|
||||||
, courseDescription = cfDesc res
|
{ courseName = cfName
|
||||||
, courseLinkExternal = cfLink res
|
, courseDescription = cfDesc
|
||||||
, courseShorthand = cfShort res
|
, courseLinkExternal = cfLink
|
||||||
, courseTerm = cfTerm res
|
, courseShorthand = cfShort
|
||||||
, courseSchool = cfSchool res
|
, courseTerm = cfTerm
|
||||||
, courseCapacity = cfCapacity res
|
, courseSchool = cfSchool
|
||||||
, courseRegisterSecret = cfSecret res
|
, courseCapacity = cfCapacity
|
||||||
, courseMaterialFree = cfMatFree res
|
, courseRegisterSecret = cfSecret
|
||||||
, courseRegisterFrom = cfRegFrom res
|
, courseMaterialFree = cfMatFree
|
||||||
, courseRegisterTo = cfRegTo res
|
, courseApplicationsRequired = cfAppRequired
|
||||||
, courseDeregisterUntil = cfDeRegUntil res
|
, courseApplicationsInstructions = cfAppInstructions
|
||||||
}
|
, courseApplicationsText = cfAppText
|
||||||
|
, courseApplicationsFiles = cfAppFiles
|
||||||
|
, courseApplicationsRatingsVisible = cfAppRatingsVisible
|
||||||
|
, courseRegisterFrom = cfRegFrom
|
||||||
|
, courseRegisterTo = cfRegTo
|
||||||
|
, courseDeregisterUntil = cfDeRegUntil
|
||||||
|
}
|
||||||
whenIsJust insertOkay $ \cid -> do
|
whenIsJust insertOkay $ \cid -> do
|
||||||
let (invites, adds) = partitionEithers $ cfLecturers res
|
let (invites, adds) = partitionEithers $ cfLecturers res
|
||||||
insertMany_ $ map (\(lid, lty) -> Lecturer lid cid lty) adds
|
insertMany_ $ map (\(lid, lty) -> Lecturer lid cid lty) adds
|
||||||
@ -466,20 +474,26 @@ courseEditHandler miButtonAction mbCourseForm = do
|
|||||||
case old of
|
case old of
|
||||||
Nothing -> addMessageI Error MsgInvalidInput $> False
|
Nothing -> addMessageI Error MsgInvalidInput $> False
|
||||||
(Just _) -> do
|
(Just _) -> do
|
||||||
updOkay <- myReplaceUnique cid Course
|
updOkay <- let CourseForm{..} = res
|
||||||
{ courseName = cfName res
|
in myReplaceUnique cid Course
|
||||||
, courseDescription = cfDesc res
|
{ courseName = cfName
|
||||||
, courseLinkExternal = cfLink res
|
, courseDescription = cfDesc
|
||||||
, courseShorthand = cfShort res
|
, courseLinkExternal = cfLink
|
||||||
, courseTerm = cfTerm res -- dangerous
|
, courseShorthand = cfShort
|
||||||
, courseSchool = cfSchool res
|
, courseTerm = cfTerm -- dangerous
|
||||||
, courseCapacity = cfCapacity res
|
, courseSchool = cfSchool
|
||||||
, courseRegisterSecret = cfSecret res
|
, courseCapacity = cfCapacity
|
||||||
, courseMaterialFree = cfMatFree res
|
, courseRegisterSecret = cfSecret
|
||||||
, courseRegisterFrom = cfRegFrom res
|
, courseMaterialFree = cfMatFree
|
||||||
, courseRegisterTo = cfRegTo res
|
, courseApplicationsRequired = cfAppRequired
|
||||||
, courseDeregisterUntil = cfDeRegUntil res
|
, courseApplicationsInstructions = cfAppInstructions
|
||||||
}
|
, courseApplicationsText = cfAppText
|
||||||
|
, courseApplicationsFiles = cfAppFiles
|
||||||
|
, courseApplicationsRatingsVisible = cfAppRatingsVisible
|
||||||
|
, courseRegisterFrom = cfRegFrom
|
||||||
|
, courseRegisterTo = cfRegTo
|
||||||
|
, courseDeregisterUntil = cfDeRegUntil
|
||||||
|
}
|
||||||
case updOkay of
|
case updOkay of
|
||||||
(Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False
|
(Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
@ -490,7 +504,19 @@ courseEditHandler miButtonAction mbCourseForm = do
|
|||||||
sinkInvitationsF lecturerInvitationConfig $ map (\(lEmail, mLty) -> (lEmail, cid, (InvDBDataLecturer mLty, InvTokenDataLecturer))) invites
|
sinkInvitationsF lecturerInvitationConfig $ map (\(lEmail, mLty) -> (lEmail, cid, (InvDBDataLecturer mLty, InvTokenDataLecturer))) invites
|
||||||
|
|
||||||
insert_ $ CourseEdit aid now cid
|
insert_ $ CourseEdit aid now cid
|
||||||
|
|
||||||
|
let
|
||||||
|
finsert val = do
|
||||||
|
fId <- lift $ either return insert val
|
||||||
|
tell $ Set.singleton fId
|
||||||
|
lift $
|
||||||
|
void . insertUnique $ CourseAppInstructionFile cid fId
|
||||||
|
keep <- execWriterT . runConduit $ transPipe liftHandlerT (traverse_ id $ cfAppInstructionFiles res) .| C.mapM_ finsert
|
||||||
|
acfs <- selectList [ CourseAppInstructionFileCourse ==. cid, CourseAppInstructionFileFile /<-. Set.toList keep ] []
|
||||||
|
mapM_ deleteCascade $ map (courseAppInstructionFileFile . entityVal) acfs
|
||||||
|
|
||||||
upsertAllocationCourse cid $ cfAllocation res
|
upsertAllocationCourse cid $ cfAllocation res
|
||||||
|
|
||||||
addMessageI Success $ MsgCourseEditOk tid ssh csh
|
addMessageI Success $ MsgCourseEditOk tid ssh csh
|
||||||
return True
|
return True
|
||||||
when success $ redirect $ CourseR tid ssh csh CShowR
|
when success $ redirect $ CourseR tid ssh csh CShowR
|
||||||
@ -522,38 +548,17 @@ upsertAllocationCourse cid cfAllocation = do
|
|||||||
|
|
||||||
when doEdit $
|
when doEdit $
|
||||||
case cfAllocation of
|
case cfAllocation of
|
||||||
Just AllocationCourseForm{..} -> do
|
Just AllocationCourseForm{..} ->
|
||||||
Entity acId _ <- upsert AllocationCourse
|
void $ upsert AllocationCourse
|
||||||
{ allocationCourseAllocation = acfAllocation
|
{ allocationCourseAllocation = acfAllocation
|
||||||
, allocationCourseCourse = cid
|
, allocationCourseCourse = cid
|
||||||
, allocationCourseMinCapacity = acfMinCapacity
|
, allocationCourseMinCapacity = acfMinCapacity
|
||||||
, allocationCourseInstructions = acfInstructions
|
|
||||||
, allocationCourseApplicationText = acfApplicationText
|
|
||||||
, allocationCourseApplicationFiles = acfApplicationFiles
|
|
||||||
, allocationCourseRatingsVisible = acfApplicationRatingsVisible
|
|
||||||
}
|
}
|
||||||
[ AllocationCourseAllocation =. acfAllocation
|
[ AllocationCourseAllocation =. acfAllocation
|
||||||
, AllocationCourseCourse =. cid
|
, AllocationCourseCourse =. cid
|
||||||
, AllocationCourseMinCapacity =. acfMinCapacity
|
, AllocationCourseMinCapacity =. acfMinCapacity
|
||||||
, AllocationCourseInstructions =. acfInstructions
|
|
||||||
, AllocationCourseApplicationText =. acfApplicationText
|
|
||||||
, AllocationCourseApplicationFiles =. acfApplicationFiles
|
|
||||||
, AllocationCourseRatingsVisible =. acfApplicationRatingsVisible
|
|
||||||
]
|
]
|
||||||
|
|
||||||
let
|
|
||||||
finsert val = do
|
|
||||||
fId <- lift $ either return insert val
|
|
||||||
tell $ Set.singleton fId
|
|
||||||
lift $
|
|
||||||
void . insertUnique $ AllocationCourseFile acId fId
|
|
||||||
keep <- execWriterT . runConduit $ transPipe liftHandlerT (traverse_ id acfFiles) .| C.mapM_ finsert
|
|
||||||
acfs <- selectList [ AllocationCourseFileAllocationCourse ==. acId, AllocationCourseFileFile /<-. Set.toList keep ] []
|
|
||||||
mapM_ deleteCascade $ map (allocationCourseFileFile . entityVal) acfs
|
|
||||||
Nothing
|
Nothing
|
||||||
| Just (Entity prevId _) <- prevAllocationCourse
|
| Just (Entity prevId _) <- prevAllocationCourse
|
||||||
-> do
|
-> delete prevId
|
||||||
acfs <- selectList [ AllocationCourseFileAllocationCourse ==. prevId ] []
|
|
||||||
mapM_ deleteCascade $ map (allocationCourseFileFile . entityVal) acfs
|
|
||||||
delete prevId
|
|
||||||
_other -> return ()
|
_other -> return ()
|
||||||
|
|||||||
@ -82,10 +82,13 @@ participantInvitationConfig = InvitationConfig{..}
|
|||||||
invitationRestriction _ _ = return Authorized
|
invitationRestriction _ _ = return Authorized
|
||||||
invitationForm (Entity _ Course{..}) _ uid = hoistAForm lift . wFormToAForm $ do
|
invitationForm (Entity _ Course{..}) _ uid = hoistAForm lift . wFormToAForm $ do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
studyFeatures <- wreq (studyFeaturesPrimaryFieldFor False [] $ Just uid)
|
studyFeatures <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid)
|
||||||
(fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTooltip) Nothing
|
(fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
|
||||||
return . fmap (, ()) $ JunctionParticipant <$> pure now <*> studyFeatures <*> pure False
|
return . fmap (, ()) $ JunctionParticipant <$> pure now <*> studyFeatures <*> pure False
|
||||||
invitationInsertHook _ _ _ _ = id
|
invitationInsertHook _ _ CourseParticipant{..} _ act = do
|
||||||
|
res <- act
|
||||||
|
audit $ TransactionCourseParticipantEdit courseParticipantCourse courseParticipantUser
|
||||||
|
return res
|
||||||
invitationSuccessMsg (Entity _ Course{..}) _ =
|
invitationSuccessMsg (Entity _ Course{..}) _ =
|
||||||
return . SomeMessage $ MsgCourseParticipantInvitationAccepted (CI.original courseName)
|
return . SomeMessage $ MsgCourseParticipantInvitationAccepted (CI.original courseName)
|
||||||
invitationUltDest (Entity _ Course{..}) _ = return . SomeRoute $ CourseR courseTerm courseSchool courseShorthand CShowR
|
invitationUltDest (Entity _ Course{..}) _ = return . SomeRoute $ CourseR courseTerm courseSchool courseShorthand CShowR
|
||||||
@ -165,6 +168,7 @@ postCAddUserR tid ssh csh = do
|
|||||||
, courseParticipantAllocated = False
|
, courseParticipantAllocated = False
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
|
lift . lift . audit $ TransactionCourseParticipantEdit cid uid
|
||||||
|
|
||||||
return $ case courseParticipantField of
|
return $ case courseParticipantField of
|
||||||
Nothing -> mempty { aurNoUniquePrimaryField = pure userEmail }
|
Nothing -> mempty { aurNoUniquePrimaryField = pure userEmail }
|
||||||
|
|||||||
@ -1,64 +1,153 @@
|
|||||||
module Handler.Course.Register
|
module Handler.Course.Register
|
||||||
( ButtonCourseRegister(..)
|
( ButtonCourseRegister(..)
|
||||||
|
, CourseRegisterForm(..)
|
||||||
, courseRegisterForm
|
, courseRegisterForm
|
||||||
, getCRegisterR, postCRegisterR
|
, getCRegisterR, postCRegisterR
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
|
||||||
import Utils.Form
|
import Utils.Lens
|
||||||
import Handler.Utils
|
import Handler.Utils
|
||||||
|
|
||||||
import Data.Function ((&))
|
import Data.Function ((&))
|
||||||
|
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
|
||||||
|
import qualified Data.Conduit.List as C
|
||||||
|
|
||||||
|
import Database.Persist.Sql (transactionUndo)
|
||||||
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
|
|
||||||
-- Dedicated CourseRegistrationButton
|
-- Dedicated CourseRegistrationButton
|
||||||
data ButtonCourseRegister = BtnCourseRegister | BtnCourseDeregister
|
data ButtonCourseRegister = BtnCourseRegister | BtnCourseDeregister | BtnCourseApply | BtnCourseRetractApplication
|
||||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||||
instance Universe ButtonCourseRegister
|
instance Universe ButtonCourseRegister
|
||||||
instance Finite ButtonCourseRegister
|
instance Finite ButtonCourseRegister
|
||||||
nullaryPathPiece ''ButtonCourseRegister $ camelToPathPiece' 1
|
nullaryPathPiece ''ButtonCourseRegister $ camelToPathPiece' 1
|
||||||
embedRenderMessage ''UniWorX ''ButtonCourseRegister id
|
embedRenderMessage ''UniWorX ''ButtonCourseRegister id
|
||||||
instance Button UniWorX ButtonCourseRegister where
|
instance Button UniWorX ButtonCourseRegister where
|
||||||
btnClasses BtnCourseRegister = [BCIsButton, BCPrimary]
|
btnClasses BtnCourseRegister = [BCIsButton, BCPrimary]
|
||||||
btnClasses BtnCourseDeregister = [BCIsButton, BCDanger]
|
btnClasses BtnCourseDeregister = [BCIsButton, BCDanger]
|
||||||
|
btnClasses BtnCourseApply = [BCIsButton, BCPrimary]
|
||||||
|
btnClasses BtnCourseRetractApplication = [BCIsButton, BCDanger]
|
||||||
|
|
||||||
btnLabel BtnCourseRegister = [whamlet|#{iconEnrol True} _{MsgBtnCourseRegister}|]
|
btnLabel BtnCourseRegister = [whamlet|#{iconEnrol True} _{MsgBtnCourseRegister}|]
|
||||||
btnLabel BtnCourseDeregister = [whamlet|#{iconEnrol False} _{MsgBtnCourseDeregister}|]
|
btnLabel BtnCourseDeregister = [whamlet|#{iconEnrol False} _{MsgBtnCourseDeregister}|]
|
||||||
|
btnLabel BtnCourseApply = [whamlet|#{iconApply True} _{MsgBtnCourseApply}|]
|
||||||
|
btnLabel BtnCourseRetractApplication = [whamlet|#{iconApply False} _{MsgBtnCourseRetractApplication}|]
|
||||||
|
|
||||||
|
|
||||||
-- | Registration button with maybe a userid if logged in
|
data CourseRegisterForm = CourseRegisterForm
|
||||||
-- , maybe existing features if already registered
|
{ crfStudyFeatures :: Maybe StudyFeaturesId
|
||||||
-- , maybe some default study features
|
, crfApplicationText :: Maybe Text
|
||||||
-- , maybe a course secret
|
, crfApplicationFiles :: Maybe (Source Handler File)
|
||||||
courseRegisterForm :: Maybe UserId -> Maybe CourseParticipant -> Maybe StudyFeaturesId -> Maybe Text -> Form (Maybe StudyFeaturesId, Bool)
|
}
|
||||||
-- unfinished WIP: must take study features if registred and show as mforced field
|
|
||||||
courseRegisterForm loggedin participant defSFid msecret = identifyForm FIDcourseRegister $ \extra -> do
|
|
||||||
-- secret fields
|
|
||||||
(msecretRes', msecretView) <- case msecret of
|
|
||||||
(Just _) | not isRegistered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
|
|
||||||
_ -> return (Nothing,Nothing)
|
|
||||||
-- study features
|
|
||||||
(msfRes', msfView) <- case loggedin of
|
|
||||||
Nothing -> return (Nothing,Nothing)
|
|
||||||
Just _ -> bimap Just Just <$> case participant of
|
|
||||||
Just CourseParticipant{courseParticipantField=Just sfid}
|
|
||||||
-> mforced (studyFeaturesPrimaryFieldFor False [sfid] loggedin) (fslI MsgCourseStudyFeature) (Just sfid)
|
|
||||||
_other -> mreq (studyFeaturesPrimaryFieldFor False [ ] loggedin) (fslI MsgCourseStudyFeature
|
|
||||||
& setTooltip MsgCourseStudyFeatureTooltip) (Just defSFid)
|
|
||||||
-- button de-/register
|
|
||||||
(btnRes, btnView) <- mreq (buttonField $ bool BtnCourseRegister BtnCourseDeregister isRegistered) "buttonField ignores settings anyway" Nothing
|
|
||||||
|
|
||||||
let widget = $(widgetFile "widgets/register-form/register-form")
|
courseRegisterForm :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Course -> m (AForm Handler CourseRegisterForm, ButtonCourseRegister)
|
||||||
let msecretRes | Just res <- msecretRes' = Just <$> res
|
-- ^ `CourseRegisterForm` for current user
|
||||||
| otherwise = FormSuccess Nothing
|
courseRegisterForm (Entity cid Course{..}) = liftHandlerT $ do
|
||||||
let msfRes | Just res <- msfRes' = res
|
muid <- maybeAuthId
|
||||||
| otherwise = FormSuccess Nothing
|
(registration, application) <- runDB $ do
|
||||||
-- checks that correct button was pressed, and ignores result of btnRes
|
registration <- fmap join . for muid $ getBy . flip UniqueParticipant cid
|
||||||
let formRes = (,) <$ btnRes <*> msfRes <*> ((==msecret) <$> msecretRes)
|
application <- fmap (listToMaybe =<<) . for muid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
|
||||||
return (formRes, widget)
|
return (registration, application)
|
||||||
where
|
let btn | courseApplicationsRequired
|
||||||
isRegistered = isJust participant
|
, is _Just application
|
||||||
|
= BtnCourseRetractApplication
|
||||||
|
| is _Just registration
|
||||||
|
= BtnCourseDeregister
|
||||||
|
| courseApplicationsRequired
|
||||||
|
= BtnCourseApply
|
||||||
|
| otherwise
|
||||||
|
= BtnCourseRegister
|
||||||
|
isRegistered = btn `elem` [BtnCourseRetractApplication, BtnCourseDeregister]
|
||||||
|
return . (, btn) . wFormToAForm $ do
|
||||||
|
MsgRenderer mr <- getMsgRenderer
|
||||||
|
|
||||||
|
secretRes <- if
|
||||||
|
| Just secret <- courseRegisterSecret
|
||||||
|
, not isRegistered
|
||||||
|
-> let guardSecret (FormSuccess secret')
|
||||||
|
| secret == secret' = return $ FormSuccess ()
|
||||||
|
| otherwise = formFailure [MsgCourseSecretWrong]
|
||||||
|
guardSecret FormMissing = return FormMissing
|
||||||
|
guardSecret (FormFailure errs) = return $ FormFailure errs
|
||||||
|
in guardSecret =<< wreq textField (fslpI MsgCourseSecret $ mr MsgCourseSecret) Nothing
|
||||||
|
| otherwise
|
||||||
|
-> return $ FormSuccess ()
|
||||||
|
|
||||||
|
fieldRes <- if
|
||||||
|
| is _Nothing muid
|
||||||
|
-> return $ FormSuccess Nothing
|
||||||
|
| is _Just muid
|
||||||
|
, isRegistered
|
||||||
|
, Just mFeature <- courseApplicationField . entityVal <$> application
|
||||||
|
<|> courseParticipantField . entityVal <$> registration
|
||||||
|
-> wforced (studyFeaturesFieldFor Nothing True (maybeToList mFeature) muid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) mFeature
|
||||||
|
| otherwise
|
||||||
|
-> wreq (studyFeaturesFieldFor Nothing False [] muid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
|
||||||
|
|
||||||
|
appTextRes <- let fs | courseApplicationsRequired
|
||||||
|
, is _Just courseApplicationsInstructions
|
||||||
|
= fslI MsgCourseApplicationText & setTooltip MsgCourseApplicationFollowInstructions
|
||||||
|
| courseApplicationsRequired
|
||||||
|
= fslI MsgCourseApplicationText
|
||||||
|
| is _Just courseApplicationsInstructions
|
||||||
|
= fslI MsgCourseRegistrationText & setTooltip MsgCourseRegistrationFollowInstructions
|
||||||
|
| otherwise
|
||||||
|
= fslI MsgCourseRegistrationText
|
||||||
|
textField' = convertField unTextarea Textarea textareaField
|
||||||
|
in if
|
||||||
|
| not courseApplicationsText
|
||||||
|
-> return $ FormSuccess Nothing
|
||||||
|
| is _Just muid
|
||||||
|
, isRegistered
|
||||||
|
-> wforced (convertField Just (fromMaybe Text.empty) textField') fs (application >>= courseApplicationText . entityVal)
|
||||||
|
| otherwise
|
||||||
|
-> fmap (assertM (not . Text.null) . fmap Text.strip) <$> wopt textField' fs (Just $ application >>= courseApplicationText . entityVal)
|
||||||
|
|
||||||
|
hasFiles <- for application $ \(Entity appId _)
|
||||||
|
-> fmap (not . null) . liftHandlerT . runDB $ selectKeysList [ CourseApplicationFileApplication ==. appId ] [ LimitTo 1 ]
|
||||||
|
appCID <- for application $ encrypt . entityKey
|
||||||
|
let appFilesInfo = (,) <$> hasFiles <*> appCID
|
||||||
|
filesMsg = bool MsgCourseRegistrationFiles MsgCourseApplicationFiles courseApplicationsRequired
|
||||||
|
|
||||||
|
if
|
||||||
|
| isn't _NoUpload courseApplicationsFiles || fromMaybe False hasFiles
|
||||||
|
-> let filesLinkField = Field{..}
|
||||||
|
where
|
||||||
|
fieldParse _ _ = return $ Right Nothing
|
||||||
|
fieldEnctype = mempty
|
||||||
|
fieldView theId _ attrs _ _
|
||||||
|
= [whamlet|
|
||||||
|
$newline never
|
||||||
|
$case appFilesInfo
|
||||||
|
$of Just (True, appCID)
|
||||||
|
<a ##{theId} *{attrs} href=@{CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR}>
|
||||||
|
_{filesMsg}
|
||||||
|
$of _
|
||||||
|
<span ##{theId} *{attrs}>
|
||||||
|
_{MsgCourseApplicationNoFiles}
|
||||||
|
|]
|
||||||
|
in void $ wforced filesLinkField (fslI filesMsg) Nothing
|
||||||
|
| otherwise
|
||||||
|
-> return ()
|
||||||
|
|
||||||
|
appFilesRes <- let mkFs | courseApplicationsRequired = bool MsgCourseApplicationFile MsgCourseApplicationArchive
|
||||||
|
| otherwise = bool MsgCourseRegistrationFile MsgCourseRegistrationArchive
|
||||||
|
in if
|
||||||
|
| isRegistered
|
||||||
|
-> return $ FormSuccess Nothing
|
||||||
|
| otherwise
|
||||||
|
-> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
|
||||||
|
|
||||||
|
return $ CourseRegisterForm
|
||||||
|
<$ secretRes
|
||||||
|
<*> fieldRes
|
||||||
|
<*> appTextRes
|
||||||
|
<*> appFilesRes
|
||||||
|
|
||||||
|
|
||||||
-- | Workaround for klicking register button without being logged in.
|
-- | Workaround for klicking register button without being logged in.
|
||||||
@ -76,21 +165,85 @@ getCRegisterR tid ssh csh = do
|
|||||||
|
|
||||||
postCRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
postCRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||||
postCRegisterR tid ssh csh = do
|
postCRegisterR tid ssh csh = do
|
||||||
aid <- requireAuthId
|
uid <- requireAuthId
|
||||||
(cid, course, registration) <- runDB $ do
|
course@(Entity cid Course{..}) <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||||
(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
(courseRegisterForm', courseRegisterButton) <- courseRegisterForm course
|
||||||
registration <- getBy (UniqueParticipant aid cid)
|
((regResult,_), _) <- runFormPost $ renderAForm FormStandard courseRegisterForm'
|
||||||
return (cid, course, entityVal <$> registration)
|
formResult regResult $ \CourseRegisterForm{..} -> do
|
||||||
let isRegistered = isJust registration
|
cTime <- liftIO getCurrentTime
|
||||||
((regResult,_), _) <- runFormPost $ courseRegisterForm (Just aid) registration Nothing $ courseRegisterSecret course
|
let
|
||||||
formResult regResult $ \(mbSfId,codeOk) -> if
|
mkApplication
|
||||||
| isRegistered -> do
|
| courseApplicationsRequired || is _Just (void crfApplicationText <|> void crfApplicationFiles)
|
||||||
runDB $ deleteBy $ UniqueParticipant aid cid
|
= void <$> do
|
||||||
addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
|
appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
|
||||||
| codeOk -> do
|
appRes <- case appIds of
|
||||||
actTime <- liftIO getCurrentTime
|
[] -> insertUnique $ CourseApplication cid uid crfStudyFeatures crfApplicationText Nothing Nothing Nothing Nothing cTime
|
||||||
regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime mbSfId False
|
(prevId:ps) -> do
|
||||||
when (isJust regOk) $ addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
forM_ ps $ \appId -> do
|
||||||
| otherwise -> addMessageI Warning MsgCourseSecretWrong
|
deleteApplicationFiles appId
|
||||||
-- addMessage Info $ toHtml $ show regResult -- For debugging only
|
delete appId
|
||||||
|
audit $ TransactionCourseApplicationDeleted cid uid appId
|
||||||
|
|
||||||
|
deleteApplicationFiles prevId
|
||||||
|
update prevId [ CourseApplicationField =. crfStudyFeatures, CourseApplicationText =. crfApplicationText, CourseApplicationTime =. cTime ]
|
||||||
|
|
||||||
|
return $ Just prevId
|
||||||
|
|
||||||
|
whenIsJust appRes $
|
||||||
|
audit . TransactionCourseApplicationEdit cid uid
|
||||||
|
whenIsJust ((,) <$> appRes <*> crfApplicationFiles) $ \(appId, fSource) -> do
|
||||||
|
runConduit $ transPipe liftHandlerT fSource .| C.mapM_ (\f -> insert f >>= insert_ . CourseApplicationFile appId)
|
||||||
|
return appRes
|
||||||
|
| otherwise
|
||||||
|
= return $ Just ()
|
||||||
|
mkRegistration = do
|
||||||
|
audit $ TransactionCourseParticipantEdit cid uid
|
||||||
|
insertUnique $ CourseParticipant cid uid cTime crfStudyFeatures False
|
||||||
|
|
||||||
|
deleteApplications = do
|
||||||
|
appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
|
||||||
|
forM_ appIds $ \appId -> do
|
||||||
|
deleteApplicationFiles appId
|
||||||
|
delete appId
|
||||||
|
audit $ TransactionCourseApplicationDeleted cid uid appId
|
||||||
|
|
||||||
|
deleteApplicationFiles appId = do
|
||||||
|
fs <- selectList [ CourseApplicationFileApplication ==. appId ] []
|
||||||
|
deleteCascadeWhere [ FileId <-. map (courseApplicationFileFile . entityVal) fs ]
|
||||||
|
case courseRegisterButton of
|
||||||
|
BtnCourseRegister -> runDB $ do
|
||||||
|
regOk <- (\app reg -> (,) <$> app <*> reg) <$> mkApplication <*> mkRegistration
|
||||||
|
case regOk of
|
||||||
|
Nothing -> transactionUndo
|
||||||
|
Just _ -> addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
||||||
|
BtnCourseDeregister -> runDB $ do
|
||||||
|
deleteApplications
|
||||||
|
deleteBy $ UniqueParticipant uid cid
|
||||||
|
audit $ TransactionCourseParticipantDeleted cid uid
|
||||||
|
|
||||||
|
examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do
|
||||||
|
E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||||
|
E.where_ $ exam E.^. ExamCourse E.==. E.val cid
|
||||||
|
return examRegistration
|
||||||
|
forM_ examRegistrations $ \(Entity erId ExamRegistration{..}) -> do
|
||||||
|
delete erId
|
||||||
|
audit $ TransactionExamDeregister examRegistrationExam uid
|
||||||
|
|
||||||
|
examResults <- E.select . E.from $ \(examResult `E.InnerJoin` exam) -> do
|
||||||
|
E.on $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
|
||||||
|
E.where_ $ exam E.^. ExamCourse E.==. E.val cid
|
||||||
|
return examResult
|
||||||
|
forM_ examResults $ \(Entity erId ExamResult{..}) -> do
|
||||||
|
delete erId
|
||||||
|
audit $ TransactionExamResultDeleted examResultExam uid
|
||||||
|
|
||||||
|
addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
|
||||||
|
BtnCourseApply -> runDB $ do
|
||||||
|
regOk <- mkApplication
|
||||||
|
case regOk of
|
||||||
|
Nothing -> transactionUndo
|
||||||
|
Just _ -> addMessageIconI Success IconApplyTrue MsgCourseApplyOk
|
||||||
|
BtnCourseRetractApplication -> runDB $ do
|
||||||
|
deleteApplications
|
||||||
|
addMessageIconI Info IconApplyFalse MsgCourseRetractApplyOk
|
||||||
redirect $ CourseR tid ssh csh CShowR
|
redirect $ CourseR tid ssh csh CShowR
|
||||||
|
|||||||
@ -1,5 +1,6 @@
|
|||||||
module Handler.Course.Show
|
module Handler.Course.Show
|
||||||
( getCShowR
|
( getCShowR
|
||||||
|
, getCRegisterTemplateR
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
@ -11,7 +12,7 @@ import qualified Database.Esqueleto.Utils as E
|
|||||||
import Database.Esqueleto.Utils.TH
|
import Database.Esqueleto.Utils.TH
|
||||||
|
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import Data.Function ((&))
|
import Utils.Lens
|
||||||
|
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
@ -19,11 +20,15 @@ import qualified Database.Esqueleto as E
|
|||||||
|
|
||||||
import Handler.Course.Register
|
import Handler.Course.Register
|
||||||
|
|
||||||
|
import System.FilePath (addExtension)
|
||||||
|
|
||||||
|
import qualified Data.Conduit.List as C
|
||||||
|
|
||||||
|
|
||||||
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||||
getCShowR tid ssh csh = do
|
getCShowR tid ssh csh = do
|
||||||
mbAid <- maybeAuthId
|
mbAid <- maybeAuthId
|
||||||
(cid,course,schoolName,participants,registration,defSFid,lecturers,assistants,correctors,tutors,mAllocation) <- runDB . maybeT notFound $ do
|
(cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication) <- runDB . maybeT notFound $ do
|
||||||
[(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
|
[(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
|
||||||
<- lift . E.select . E.from $
|
<- lift . E.select . E.from $
|
||||||
\((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
|
\((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
|
||||||
@ -38,7 +43,6 @@ getCShowR tid ssh csh = do
|
|||||||
E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
|
||||||
return ( E.countRows :: E.SqlExpr (E.Value Int))
|
return ( E.countRows :: E.SqlExpr (E.Value Int))
|
||||||
return (course,school E.^. SchoolName, numParticipants, participant)
|
return (course,school E.^. SchoolName, numParticipants, participant)
|
||||||
defSFid <- ifMaybeM mbAid Nothing $ \uid -> lift $ selectFirst [StudyFeaturesUser ==. uid, StudyFeaturesType ==. FieldPrimary, StudyFeaturesValid ==. True] [Desc StudyFeaturesUpdated, Desc StudyFeaturesDegree, Desc StudyFeaturesField] -- sorting by degree & field is an heuristic only, but this is okay for a default suggestion
|
|
||||||
staff <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
|
staff <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
|
||||||
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
|
||||||
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
||||||
@ -66,19 +70,27 @@ getCShowR tid ssh csh = do
|
|||||||
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
|
E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
|
||||||
E.limit 1
|
E.limit 1
|
||||||
return allocation
|
return allocation
|
||||||
return (cid,course,schoolName,participants,registration,entityKey <$> defSFid,lecturers,assistants,correctors,tutors,mAllocation)
|
hasApplicationTemplate <- lift . E.selectExists . E.from $ \courseAppInstructionFile ->
|
||||||
|
E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. E.val cid
|
||||||
|
mApplication <- lift . fmap (listToMaybe =<<) . for mbAid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
|
||||||
|
return (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication)
|
||||||
|
|
||||||
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
|
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
|
||||||
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
|
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
|
||||||
mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
|
mDereg <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
|
||||||
mRegAt <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
|
mRegAt <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
|
||||||
(regWidget, regEnctype) <- generateFormPost $ courseRegisterForm mbAid registration defSFid $ courseRegisterSecret course
|
regForm <- if
|
||||||
let regForm = wrapForm regWidget def
|
| is _Just mbAid -> do
|
||||||
{ formAction = Just . SomeRoute $ CourseR tid ssh csh CRegisterR
|
(courseRegisterForm', regButton) <- courseRegisterForm (Entity cid course)
|
||||||
, formEncoding = regEnctype
|
(regWidget, regEnctype) <- generateFormPost $ renderAForm FormStandard courseRegisterForm'
|
||||||
, formSubmit = FormNoSubmit
|
return $ wrapForm' regButton regWidget def
|
||||||
}
|
{ formAction = Just . SomeRoute $ CourseR tid ssh csh CRegisterR
|
||||||
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
|
, formEncoding = regEnctype
|
||||||
|
, formSubmit = FormSubmit
|
||||||
|
}
|
||||||
|
| otherwise
|
||||||
|
-> return . modal $(widgetFile "course/login-to-register") . Left . SomeRoute $ AuthR LoginR
|
||||||
|
registrationOpen <- hasWriteAccessTo $ CourseR tid ssh csh CRegisterR
|
||||||
|
|
||||||
let
|
let
|
||||||
tutorialDBTable = DBTable{..}
|
tutorialDBTable = DBTable{..}
|
||||||
@ -224,3 +236,15 @@ getCShowR tid ssh csh = do
|
|||||||
siteLayout (toWgt $ courseName course) $ do
|
siteLayout (toWgt $ courseName course) $ do
|
||||||
setTitleI $ prependCourseTitle tid ssh csh (""::Text)
|
setTitleI $ prependCourseTitle tid ssh csh (""::Text)
|
||||||
$(widgetFile "course")
|
$(widgetFile "course")
|
||||||
|
|
||||||
|
getCRegisterTemplateR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
|
||||||
|
getCRegisterTemplateR tid ssh csh = do
|
||||||
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgCourseApplicationTemplateArchiveName tid ssh csh
|
||||||
|
let source = (.| C.map entityVal) . E.selectSource . E.from $ \(file `E.InnerJoin` courseAppInstructionFile `E.InnerJoin` course) -> do
|
||||||
|
E.on $ course E.^. CourseId E.==. courseAppInstructionFile E.^. CourseAppInstructionFileCourse
|
||||||
|
E.on $ courseAppInstructionFile E.^. CourseAppInstructionFileFile E.==. file E.^. FileId
|
||||||
|
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||||
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
|
return file
|
||||||
|
serveSomeFiles archiveName source
|
||||||
|
|||||||
@ -95,7 +95,7 @@ postCUserR tid ssh csh uCId = do
|
|||||||
((regFieldRes, regFieldView), regFieldEnctype) <- runFormPost . identifyForm FIDcRegField $ \csrf ->
|
((regFieldRes, regFieldView), regFieldEnctype) <- runFormPost . identifyForm FIDcRegField $ \csrf ->
|
||||||
let currentField :: Maybe (Maybe StudyFeaturesId)
|
let currentField :: Maybe (Maybe StudyFeaturesId)
|
||||||
currentField = courseParticipantField . entityVal <$> mRegistration
|
currentField = courseParticipantField . entityVal <$> mRegistration
|
||||||
in over _2 ((toWidget csrf <>) . fvInput) <$> mreq (studyFeaturesPrimaryFieldFor True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField
|
in over _2 ((toWidget csrf <>) . fvInput) <$> mreq (studyFeaturesFieldFor Nothing True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField
|
||||||
|
|
||||||
let registrationFieldFrag :: Text
|
let registrationFieldFrag :: Text
|
||||||
registrationFieldFrag = "registration-field"
|
registrationFieldFrag = "registration-field"
|
||||||
@ -111,6 +111,7 @@ postCUserR tid ssh csh uCId = do
|
|||||||
formResult regFieldRes $ \courseParticipantField' -> do
|
formResult regFieldRes $ \courseParticipantField' -> do
|
||||||
runDB $ do
|
runDB $ do
|
||||||
update pId [ CourseParticipantField =. courseParticipantField' ]
|
update pId [ CourseParticipantField =. courseParticipantField' ]
|
||||||
|
audit $ TransactionCourseParticipantEdit cid uid
|
||||||
addMessageI Success MsgCourseStudyFeatureUpdated
|
addMessageI Success MsgCourseStudyFeatureUpdated
|
||||||
redirect $ currentRoute :#: registrationFieldFrag
|
redirect $ currentRoute :#: registrationFieldFrag
|
||||||
|
|
||||||
@ -140,17 +141,22 @@ postCUserR tid ssh csh uCId = do
|
|||||||
-> invalidArgs ["User not registered"]
|
-> invalidArgs ["User not registered"]
|
||||||
BtnCourseRegister -> do
|
BtnCourseRegister -> do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
let primaryField
|
let field
|
||||||
| [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesType == FieldPrimary && studyFeaturesValid) studies
|
| [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesValid) studies
|
||||||
= Just featId
|
= Just featId
|
||||||
| otherwise
|
| otherwise
|
||||||
= Nothing
|
= Nothing
|
||||||
pId <- runDB . insertUnique $ CourseParticipant cid uid now primaryField False
|
pId <- runDB $ do
|
||||||
|
pId <- insertUnique $ CourseParticipant cid uid now field False
|
||||||
|
when (is _Just pId) $
|
||||||
|
audit $ TransactionCourseParticipantEdit cid uid
|
||||||
|
return pId
|
||||||
case pId of
|
case pId of
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
|
||||||
redirect currentRoute
|
redirect currentRoute
|
||||||
Nothing -> invalidArgs ["User already registered"]
|
Nothing -> invalidArgs ["User already registered"]
|
||||||
|
_other -> fail "Invalid @regButton@"
|
||||||
|
|
||||||
mRegAt <- for (courseParticipantRegistration . entityVal <$> mRegistration) $ formatTime SelFormatDateTime
|
mRegAt <- for (courseParticipantRegistration . entityVal <$> mRegistration) $ formatTime SelFormatDateTime
|
||||||
|
|
||||||
|
|||||||
@ -251,10 +251,14 @@ postCUsersR tid ssh csh = do
|
|||||||
cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]
|
cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]
|
||||||
redirect (CourseR tid ssh csh CCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids])
|
redirect (CourseR tid ssh csh CCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids])
|
||||||
(CourseUserDeregister,selectedUsers) -> do
|
(CourseUserDeregister,selectedUsers) -> do
|
||||||
nrDel <- runDB $ deleteWhereCount
|
Sum nrDel <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> do
|
||||||
[ CourseParticipantCourse ==. cid
|
nrDel <- deleteWhereCount
|
||||||
, CourseParticipantUser <-. Set.toList selectedUsers
|
[ CourseParticipantCourse ==. cid
|
||||||
]
|
, CourseParticipantUser ==. uid
|
||||||
|
]
|
||||||
|
unless (nrDel == 0) $
|
||||||
|
audit $ TransactionCourseParticipantDeleted cid uid
|
||||||
|
return $ Sum nrDel
|
||||||
addMessageI Success $ MsgCourseUsersDeregistered nrDel
|
addMessageI Success $ MsgCourseUsersDeregistered nrDel
|
||||||
redirect $ CourseR tid ssh csh CUsersR
|
redirect $ CourseR tid ssh csh CUsersR
|
||||||
let headingLong = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{tid}|]
|
let headingLong = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{tid}|]
|
||||||
|
|||||||
@ -149,6 +149,7 @@ postEAddUserR tid ssh csh examn = do
|
|||||||
, courseParticipantAllocated = False
|
, courseParticipantAllocated = False
|
||||||
, ..
|
, ..
|
||||||
}
|
}
|
||||||
|
lift . lift . audit $ TransactionCourseParticipantEdit cid uid
|
||||||
lift $ lift examRegister
|
lift $ lift examRegister
|
||||||
|
|
||||||
return $ case courseParticipantField of
|
return $ case courseParticipantField of
|
||||||
|
|||||||
@ -90,12 +90,13 @@ examRegistrationInvitationConfig = InvitationConfig{..}
|
|||||||
case (isRegistered, invDBExamRegistrationCourseRegister) of
|
case (isRegistered, invDBExamRegistrationCourseRegister) of
|
||||||
(False, False) -> permissionDeniedI MsgUnauthorizedParticipant
|
(False, False) -> permissionDeniedI MsgUnauthorizedParticipant
|
||||||
(False, True ) -> do
|
(False, True ) -> do
|
||||||
fieldRes <- wreq (studyFeaturesPrimaryFieldFor False [] $ Just uid) (fslI MsgCourseStudyFeature) Nothing
|
fieldRes <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature) Nothing
|
||||||
return $ (JunctionExamRegistration invDBExamRegistrationOccurrence now, ) . Just <$> fieldRes
|
return $ (JunctionExamRegistration invDBExamRegistrationOccurrence now, ) . Just <$> fieldRes
|
||||||
(True , _ ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, Nothing)
|
(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 ->
|
whenIsJust mField $ \cpField -> do
|
||||||
insert_ $ CourseParticipant examCourse examRegistrationUser examRegistrationTime cpField False
|
insert_ $ CourseParticipant examCourse examRegistrationUser examRegistrationTime cpField False
|
||||||
|
audit $ TransactionCourseParticipantEdit examCourse examRegistrationUser
|
||||||
|
|
||||||
let doAudit = audit $ TransactionExamRegister eid examRegistrationUser
|
let doAudit = audit $ TransactionExamRegister eid examRegistrationUser
|
||||||
act <* doAudit
|
act <* doAudit
|
||||||
|
|||||||
@ -443,6 +443,7 @@ postEUsersR tid ssh csh examn = do
|
|||||||
, courseParticipantField = examUserCsvActCourseField
|
, courseParticipantField = examUserCsvActCourseField
|
||||||
, courseParticipantAllocated = False
|
, courseParticipantAllocated = False
|
||||||
}
|
}
|
||||||
|
audit $ TransactionCourseParticipantEdit examCourse examUserCsvActUser
|
||||||
insert_ ExamRegistration
|
insert_ ExamRegistration
|
||||||
{ examRegistrationExam = eid
|
{ examRegistrationExam = eid
|
||||||
, examRegistrationUser = examUserCsvActUser
|
, examRegistrationUser = examUserCsvActUser
|
||||||
@ -461,8 +462,10 @@ postEUsersR tid ssh csh examn = do
|
|||||||
audit $ TransactionExamRegister eid examUserCsvActUser
|
audit $ TransactionExamRegister eid examUserCsvActUser
|
||||||
ExamUserCsvAssignOccurrenceData{..} ->
|
ExamUserCsvAssignOccurrenceData{..} ->
|
||||||
update examUserCsvActRegistration [ ExamRegistrationOccurrence =. examUserCsvActOccurrence ]
|
update examUserCsvActRegistration [ ExamRegistrationOccurrence =. examUserCsvActOccurrence ]
|
||||||
ExamUserCsvSetCourseFieldData{..} ->
|
ExamUserCsvSetCourseFieldData{..} -> do
|
||||||
update examUserCsvActCourseParticipant [ CourseParticipantField =. examUserCsvActCourseField ]
|
update examUserCsvActCourseParticipant [ CourseParticipantField =. examUserCsvActCourseField ]
|
||||||
|
CourseParticipant{..} <- getJust examUserCsvActCourseParticipant
|
||||||
|
audit $ TransactionCourseParticipantEdit examCourse courseParticipantUser
|
||||||
ExamUserCsvSetResultData{..} -> case examUserCsvActExamResult of
|
ExamUserCsvSetResultData{..} -> case examUserCsvActExamResult of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
deleteBy $ UniqueExamResult eid examUserCsvActUser
|
deleteBy $ UniqueExamResult eid examUserCsvActUser
|
||||||
@ -481,6 +484,10 @@ postEUsersR tid ssh csh examn = do
|
|||||||
ExamRegistration{examRegistrationUser} <- getJust examUserCsvActRegistration
|
ExamRegistration{examRegistrationUser} <- getJust examUserCsvActRegistration
|
||||||
audit $ TransactionExamDeregister eid examRegistrationUser
|
audit $ TransactionExamDeregister eid examRegistrationUser
|
||||||
delete examUserCsvActRegistration
|
delete examUserCsvActRegistration
|
||||||
|
result <- getBy $ UniqueExamResult eid examRegistrationUser
|
||||||
|
forM_ result $ \(Entity erId _) -> do
|
||||||
|
delete erId
|
||||||
|
audit $ TransactionExamResultDeleted eid examRegistrationUser
|
||||||
ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Nothing, .. } -> do
|
ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Nothing, .. } -> do
|
||||||
noteId <- getKeyBy $ UniqueCourseUserNote examUserCsvActUser examCourse
|
noteId <- getKeyBy $ UniqueCourseUserNote examUserCsvActUser examCourse
|
||||||
whenIsJust noteId $ \nid -> do
|
whenIsJust noteId $ \nid -> do
|
||||||
@ -631,7 +638,6 @@ postEUsersR tid ssh csh examn = do
|
|||||||
, (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
|
, (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester
|
||||||
]
|
]
|
||||||
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
|
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid
|
||||||
E.&&. studyFeatures E.^. StudyFeaturesType E.==. E.val FieldPrimary
|
|
||||||
E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True
|
E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True
|
||||||
E.limit 2
|
E.limit 2
|
||||||
return $ studyFeatures E.^. StudyFeaturesId
|
return $ studyFeatures E.^. StudyFeaturesId
|
||||||
|
|||||||
@ -23,6 +23,8 @@ import Handler.Utils.Table.Columns
|
|||||||
|
|
||||||
import Control.Monad.Writer (MonadWriter(..), execWriterT)
|
import Control.Monad.Writer (MonadWriter(..), execWriterT)
|
||||||
|
|
||||||
|
import System.FilePath (addExtension)
|
||||||
|
|
||||||
|
|
||||||
data MaterialForm = MaterialForm
|
data MaterialForm = MaterialForm
|
||||||
{ mfName :: MaterialName
|
{ mfName :: MaterialName
|
||||||
@ -358,16 +360,19 @@ postMDelR tid ssh csh mnm = do
|
|||||||
|
|
||||||
-- | Serve all material-files
|
-- | Serve all material-files
|
||||||
getMArchiveR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
|
getMArchiveR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler TypedContent
|
||||||
getMArchiveR tid ssh csh mnm = serveSomeFiles archivename getMatQuery
|
getMArchiveR tid ssh csh mnm = do
|
||||||
where
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgMaterialArchiveName tid ssh csh mnm
|
||||||
archivename = unpack (termToText (unTermKey tid) <> "-" <> toPathPiece (unSchoolKey ssh <> "-" <> csh <> "-" <> mnm)) <.> "zip"
|
|
||||||
getMatQuery = (.| C.map entityVal) . E.selectSource . E.from $
|
let getMatQuery = (.| C.map entityVal) . E.selectSource . E.from $
|
||||||
\(course `E.InnerJoin` material `E.InnerJoin` materialFile `E.InnerJoin` file) -> do
|
\(course `E.InnerJoin` material `E.InnerJoin` materialFile `E.InnerJoin` file) -> do
|
||||||
E.on $ file E.^. FileId E.==. materialFile E.^. MaterialFileFile
|
E.on $ file E.^. FileId E.==. materialFile E.^. MaterialFileFile
|
||||||
E.on $ material E.^. MaterialId E.==. materialFile E.^. MaterialFileMaterial
|
E.on $ material E.^. MaterialId E.==. materialFile E.^. MaterialFileMaterial
|
||||||
E.on $ material E.^. MaterialCourse E.==. course E.^. CourseId
|
E.on $ material E.^. MaterialCourse E.==. course E.^. CourseId
|
||||||
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
E.where_ $ course E.^. CourseTerm E.==. E.val tid
|
||||||
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
E.&&. course E.^. CourseSchool E.==. E.val ssh
|
||||||
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
E.&&. course E.^. CourseShorthand E.==. E.val csh
|
||||||
E.&&. material E.^. MaterialName E.==. E.val mnm
|
E.&&. material E.^. MaterialName E.==. E.val mnm
|
||||||
return file
|
return file
|
||||||
|
|
||||||
|
serveSomeFiles archiveName getMatQuery
|
||||||
|
|
||||||
|
|||||||
@ -60,6 +60,8 @@ import Utils.Sql
|
|||||||
import Data.Aeson hiding (Result(..))
|
import Data.Aeson hiding (Result(..))
|
||||||
import Text.Hamlet (ihamlet)
|
import Text.Hamlet (ihamlet)
|
||||||
|
|
||||||
|
import System.FilePath (addExtension)
|
||||||
|
|
||||||
|
|
||||||
{-
|
{-
|
||||||
* Implement Handlers
|
* Implement Handlers
|
||||||
@ -439,9 +441,8 @@ getSShowR tid ssh csh shn = do
|
|||||||
|
|
||||||
getSArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
|
getSArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
|
||||||
getSArchiveR tid ssh csh shn = do
|
getSArchiveR tid ssh csh shn = do
|
||||||
MsgRenderer mr <- getMsgRenderer
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgSheetArchiveName tid ssh csh shn
|
||||||
let archiveName = (unpack . stripAll $ mr (prependCourseTitle tid ssh csh $ SomeMessage shn)) <.> "zip"
|
let sftArchive = CSheetR tid ssh csh shn . SZipR -- used to check access to SheetFileTypes
|
||||||
sftArchive = CSheetR tid ssh csh shn . SZipR -- used to check access to SheetFileTypes
|
|
||||||
allowedSFTs <- filterM (hasReadAccessTo . sftArchive) [minBound..maxBound]
|
allowedSFTs <- filterM (hasReadAccessTo . sftArchive) [minBound..maxBound]
|
||||||
serveZipArchive archiveName $ sheetFilesSFTsQuery tid ssh csh shn allowedSFTs .| C.map entityVal
|
serveZipArchive archiveName $ sheetFilesSFTsQuery tid ssh csh shn allowedSFTs .| C.map entityVal
|
||||||
|
|
||||||
@ -476,8 +477,8 @@ getSFileR tid ssh csh shn sft file = serveOneFile $ sheetFileQuery tid ssh csh s
|
|||||||
|
|
||||||
getSZipR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> Handler TypedContent
|
getSZipR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SheetFileType -> Handler TypedContent
|
||||||
getSZipR tid ssh csh shn sft = do
|
getSZipR tid ssh csh shn sft = do
|
||||||
MsgRenderer mr <- getMsgRenderer
|
sft' <- ap getMessageRender $ pure sft
|
||||||
let archiveName = (unpack . stripAll $ mr (prependCourseTitle tid ssh csh $ SomeMessage shn)) <> "_" <> (unpack $ toPathPiece sft) <.> "zip"
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack). ap getMessageRender . pure $ MsgSheetTypeArchiveName tid ssh csh shn sft'
|
||||||
serveSomeFiles archiveName $ sheetFilesAllQuery tid ssh csh shn sft .| C.map entityVal
|
serveSomeFiles archiveName $ sheetFilesAllQuery tid ssh csh shn sft .| C.map entityVal
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -45,6 +45,8 @@ import Text.Hamlet (ihamlet)
|
|||||||
-- import qualified Yesod.Colonnade as Yesod
|
-- import qualified Yesod.Colonnade as Yesod
|
||||||
-- import qualified Text.Blaze.Html5.Attributes as HA
|
-- import qualified Text.Blaze.Html5.Attributes as HA
|
||||||
|
|
||||||
|
import System.FilePath (addExtension)
|
||||||
|
|
||||||
-- DEPRECATED: We always show all edits!
|
-- DEPRECATED: We always show all edits!
|
||||||
-- numberOfSubmissionEditDates :: Int64
|
-- numberOfSubmissionEditDates :: Int64
|
||||||
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
|
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
|
||||||
@ -124,26 +126,9 @@ submissionUserInvitationConfig = InvitationConfig{..}
|
|||||||
|
|
||||||
makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe (Source Handler File), Set (Either UserEmail UserId))
|
makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe (Source Handler File), Set (Either UserEmail UserId))
|
||||||
makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
|
makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
|
||||||
<$> fileUploadForm
|
<$> fileUploadForm (is _Just msmid) (fslI . bool MsgSubmissionFile MsgSubmissionArchive) uploadMode
|
||||||
<*> wFormToAForm submittorsForm
|
<*> wFormToAForm submittorsForm
|
||||||
where
|
where
|
||||||
fileUploadForm = case uploadMode of
|
|
||||||
NoUpload
|
|
||||||
-> pure Nothing
|
|
||||||
UploadAny{..}
|
|
||||||
-> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips extensionRestriction) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
|
|
||||||
UploadSpecific{..}
|
|
||||||
-> mergeFileSources <$> sequenceA (map specificFileForm . Set.toList $ toNullable specificFiles)
|
|
||||||
|
|
||||||
specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe (Source Handler File))
|
|
||||||
specificFileForm spec@UploadSpecificFile{..}
|
|
||||||
= bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) specificFileRequired (specificFileField spec) (fsl specificFileLabel) Nothing
|
|
||||||
|
|
||||||
mergeFileSources :: [Maybe (Source Handler File)] -> Maybe (Source Handler File)
|
|
||||||
mergeFileSources (catMaybes -> sources) = case sources of
|
|
||||||
[] -> Nothing
|
|
||||||
fs -> Just $ sequence_ fs
|
|
||||||
|
|
||||||
miCell' :: Markup -> Either UserEmail UserId -> Widget
|
miCell' :: Markup -> Either UserEmail UserId -> Widget
|
||||||
miCell' csrf (Left email) = $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
|
miCell' csrf (Left email) = $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
|
||||||
miCell' csrf (Right uid) = do
|
miCell' csrf (Right uid) = do
|
||||||
@ -574,11 +559,10 @@ getSubArchiveR tid ssh csh shn cID sfType = do
|
|||||||
when (sfType == SubmissionCorrected) $
|
when (sfType == SubmissionCorrected) $
|
||||||
guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False
|
guardAuthResult =<< evalAccess (CSubmissionR tid ssh csh shn cID CorrectionR) False
|
||||||
|
|
||||||
let filename
|
sfType' <- ap getMessageRender $ pure sfType
|
||||||
| SubmissionOriginal <- sfType = toPathPiece cID <> "-" <> toPathPiece sfType
|
archiveName <- fmap (flip addExtension (unpack extensionZip) . unpack) . ap getMessageRender . pure $ MsgSubmissionTypeArchiveName tid ssh csh shn cID sfType'
|
||||||
| otherwise = toPathPiece cID
|
|
||||||
|
|
||||||
source = do
|
let source = do
|
||||||
submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
|
submissionID <- lift $ submissionMatchesSheet tid ssh csh shn cID
|
||||||
rating <- lift $ getRating submissionID
|
rating <- lift $ getRating submissionID
|
||||||
|
|
||||||
@ -593,7 +577,7 @@ getSubArchiveR tid ssh csh shn cID sfType = do
|
|||||||
when (sfType == SubmissionCorrected) $
|
when (sfType == SubmissionCorrected) $
|
||||||
maybe (return ()) (yieldM . ratingFile cID) rating
|
maybe (return ()) (yieldM . ratingFile cID) rating
|
||||||
|
|
||||||
serveSomeFiles (unpack filename <.> "zip") source
|
serveSomeFiles archiveName source
|
||||||
|
|
||||||
getSubDelR, postSubDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
|
getSubDelR, postSubDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
|
||||||
getSubDelR = postSubDelR
|
getSubDelR = postSubDelR
|
||||||
|
|||||||
@ -75,7 +75,7 @@ serveSomeFiles archiveName source = do
|
|||||||
[file] -> sendThisFile file
|
[file] -> sendThisFile file
|
||||||
_moreFiles -> do
|
_moreFiles -> do
|
||||||
setContentDisposition' $ Just archiveName
|
setContentDisposition' $ Just archiveName
|
||||||
respondSourceDB "application/zip" $ do
|
respondSourceDB typeZip $ do
|
||||||
let zipComment = T.encodeUtf8 $ pack archiveName
|
let zipComment = T.encodeUtf8 $ pack archiveName
|
||||||
source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
|
source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
|
||||||
|
|
||||||
@ -92,7 +92,7 @@ serveZipArchive archiveName source = do
|
|||||||
[] -> notFound
|
[] -> notFound
|
||||||
_moreFiles -> do
|
_moreFiles -> do
|
||||||
setContentDisposition' $ Just archiveName
|
setContentDisposition' $ Just archiveName
|
||||||
respondSourceDB "application/zip" $ do
|
respondSourceDB typeZip $ do
|
||||||
let zipComment = T.encodeUtf8 $ pack archiveName
|
let zipComment = T.encodeUtf8 $ pack archiveName
|
||||||
source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
|
source .| produceZip ZipInfo{..} .| Conduit.map toFlushBuilder
|
||||||
|
|
||||||
|
|||||||
@ -32,7 +32,6 @@ import qualified Data.Map as Map
|
|||||||
import qualified Data.Vector as Vector
|
import qualified Data.Vector as Vector
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
|
|
||||||
import qualified Data.ByteString as BS
|
|
||||||
import qualified Data.ByteString.Lazy as LBS
|
import qualified Data.ByteString.Lazy as LBS
|
||||||
|
|
||||||
import qualified Data.Attoparsec.ByteString.Lazy as A
|
import qualified Data.Attoparsec.ByteString.Lazy as A
|
||||||
@ -43,8 +42,8 @@ instance Exception CsvParseError
|
|||||||
|
|
||||||
|
|
||||||
typeCsv, typeCsv' :: ContentType
|
typeCsv, typeCsv' :: ContentType
|
||||||
typeCsv = "text/csv"
|
typeCsv = simpleContentType typeCsv'
|
||||||
typeCsv' = BS.intercalate "; " [typeCsv, "charset=UTF-8", "header=present"]
|
typeCsv' = "text/csv; charset=UTF-8; header=present"
|
||||||
|
|
||||||
extensionCsv :: Extension
|
extensionCsv :: Extension
|
||||||
extensionCsv = fromMaybe "csv" $ listToMaybe [ ext | (ext, mime) <- Map.toList mimeMap, mime == typeCsv ]
|
extensionCsv = fromMaybe "csv" $ listToMaybe [ ext | (ext, mime) <- Map.toList mimeMap, mime == typeCsv ]
|
||||||
|
|||||||
@ -25,6 +25,7 @@ import Handler.Utils.Zip
|
|||||||
import qualified Data.Conduit.List as C
|
import qualified Data.Conduit.List as C
|
||||||
|
|
||||||
import qualified Database.Esqueleto as E
|
import qualified Database.Esqueleto as E
|
||||||
|
import qualified Database.Esqueleto.Utils as E
|
||||||
|
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
@ -337,25 +338,35 @@ schoolFieldEnt = selectField $ optionsPersist [] [Asc SchoolName] schoolName
|
|||||||
schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
|
schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
|
||||||
schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
|
schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
|
||||||
|
|
||||||
-- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user)
|
|
||||||
|
-- | Select one of the user's primary active study features, or from a given list of StudyFeatures (regardless of user)
|
||||||
studyFeaturesPrimaryFieldFor :: Bool -- ^ Allow user to select `Nothing` (only applies if set of options is nonempty)?
|
studyFeaturesPrimaryFieldFor :: Bool -- ^ Allow user to select `Nothing` (only applies if set of options is nonempty)?
|
||||||
-> [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
|
-> [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
|
||||||
studyFeaturesPrimaryFieldFor isOptional oldFeatures mbuid = selectField $ do
|
{-# DEPRECATED studyFeaturesPrimaryFieldFor "Use studyFeaturesFieldFor" #-}
|
||||||
|
studyFeaturesPrimaryFieldFor = studyFeaturesFieldFor . Just $ Set.singleton FieldPrimary
|
||||||
|
|
||||||
|
-- | Select one of the user's active study features, or from a given list of StudyFeatures (regardless of user)
|
||||||
|
studyFeaturesFieldFor :: Maybe (Set StudyFieldType) -- ^ Optionally restrict fields to only given types
|
||||||
|
-> Bool -- ^ Allow user to select `Nothing` (only applies if set of options is nonempty)?
|
||||||
|
-> [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
|
||||||
|
studyFeaturesFieldFor mRestr isOptional oldFeatures mbuid = selectField $ do
|
||||||
-- we need a join, so we cannot just use optionsPersistCryptoId
|
-- we need a join, so we cannot just use optionsPersistCryptoId
|
||||||
rawOptions <- runDB $ E.select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` field) -> do
|
rawOptions <- runDB $ E.select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` field) -> do
|
||||||
E.on $ feature E.^. StudyFeaturesField E.==. field E.^. StudyTermsId
|
E.on $ feature E.^. StudyFeaturesField E.==. field E.^. StudyTermsId
|
||||||
E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
|
E.on $ feature E.^. StudyFeaturesDegree E.==. degree E.^. StudyDegreeId
|
||||||
E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
|
E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
|
||||||
E.||. isPrimaryActiveUserStudyFeature feature
|
E.||. (isActiveUserStudyFeature feature E.&&. isCorrectType feature)
|
||||||
return (feature E.^. StudyFeaturesId, degree, field)
|
return (feature E.^. StudyFeaturesId, degree, field)
|
||||||
MsgRenderer mr <- getMsgRenderer
|
MsgRenderer mr <- getMsgRenderer
|
||||||
mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM (procOptions mr) rawOptions
|
mkOptionList . nonEmptyOptions (mr MsgNoStudyField) <$> mapM (procOptions mr) rawOptions
|
||||||
where
|
where
|
||||||
isPrimaryActiveUserStudyFeature feature = case mbuid of
|
isActiveUserStudyFeature feature = case mbuid of
|
||||||
Nothing -> E.val False
|
Nothing -> E.false
|
||||||
(Just uid) -> feature E.^. StudyFeaturesUser E.==. E.val uid
|
Just uid -> feature E.^. StudyFeaturesUser E.==. E.val uid
|
||||||
E.&&. feature E.^. StudyFeaturesValid E.==. E.val True
|
E.&&. feature E.^. StudyFeaturesValid
|
||||||
E.&&. feature E.^. StudyFeaturesType E.==. E.val FieldPrimary
|
isCorrectType feature = case mRestr of
|
||||||
|
Nothing -> E.true
|
||||||
|
Just restr -> feature E.^. StudyFeaturesType `E.in_` E.valList (Set.toList restr)
|
||||||
|
|
||||||
procOptions :: (StudyDegreeTerm -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
|
procOptions :: (StudyDegreeTerm -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
|
||||||
procOptions mr (E.Value sfid, Entity _dgid sdegree, Entity _stid sterm) = do
|
procOptions mr (E.Value sfid, Entity _dgid sdegree, Entity _stid sterm) = do
|
||||||
@ -375,7 +386,7 @@ studyFeaturesPrimaryFieldFor isOptional oldFeatures mbuid = selectField $ do
|
|||||||
nullOption = Option
|
nullOption = Option
|
||||||
{ optionDisplay = emptyOpt
|
{ optionDisplay = emptyOpt
|
||||||
, optionInternalValue = Nothing
|
, optionInternalValue = Nothing
|
||||||
, optionExternalValue = "NoPrimaryStudyField"
|
, optionExternalValue = "NoStudyField"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
@ -387,7 +398,7 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
|
|||||||
[ ( UploadModeNone, pure NoUpload)
|
[ ( UploadModeNone, pure NoUpload)
|
||||||
, ( UploadModeAny
|
, ( UploadModeAny
|
||||||
, UploadAny
|
, UploadAny
|
||||||
<$> apreq checkBoxField (fslI MsgUploadModeUnpackZips & setTooltip MsgUploadModeUnpackZipsTip) (prev ^? _Just . _unpackZips)
|
<$> (fromMaybe False <$> aopt checkBoxField (fslI MsgUploadModeUnpackZips & setTooltip MsgUploadModeUnpackZipsTip) (Just $ prev ^? _Just . _unpackZips))
|
||||||
<*> aopt extensionRestrictionField (fslI MsgUploadModeExtensionRestriction & setTooltip MsgUploadModeExtensionRestrictionTip) ((prev ^? _Just . _extensionRestriction) <|> fmap Just defaultExtensionRestriction)
|
<*> aopt extensionRestrictionField (fslI MsgUploadModeExtensionRestriction & setTooltip MsgUploadModeExtensionRestrictionTip) ((prev ^? _Just . _extensionRestriction) <|> fmap Just defaultExtensionRestriction)
|
||||||
)
|
)
|
||||||
, ( UploadModeSpecific
|
, ( UploadModeSpecific
|
||||||
@ -458,6 +469,8 @@ uploadModeForm prev = multiActionA actions (fslI MsgSheetUploadMode) (classifyUp
|
|||||||
miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/uploadSpecificFiles/layout")
|
miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/uploadSpecificFiles/layout")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
submissionModeForm :: Maybe SubmissionMode -> AForm Handler SubmissionMode
|
submissionModeForm :: Maybe SubmissionMode -> AForm Handler SubmissionMode
|
||||||
submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ classifySubmissionMode <$> prev
|
submissionModeForm prev = multiActionA actions (fslI MsgSheetSubmissionMode) $ classifySubmissionMode <$> prev
|
||||||
where
|
where
|
||||||
@ -648,12 +661,37 @@ zipFileField doUnpack permittedExtensions = Field{..}
|
|||||||
| otherwise = return . Left $ SomeMessage MsgOnlyUploadOneFile
|
| otherwise = return . Left $ SomeMessage MsgOnlyUploadOneFile
|
||||||
fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/zipFileField")
|
fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/zipFileField")
|
||||||
|
|
||||||
zipExtensions = mimeExtensions "application/zip"
|
zipExtensions = mimeExtensions typeZip
|
||||||
|
|
||||||
acceptRestricted = isJust permittedExtensions
|
acceptRestricted = isJust permittedExtensions
|
||||||
accept = Text.intercalate "," . map ("." <>) $ bool [] (Set.toList zipExtensions) doUnpack ++ toListOf (_Just . re _nullable . folded) permittedExtensions
|
accept = Text.intercalate "," . map ("." <>) $ bool [] (Set.toList zipExtensions) doUnpack ++ toListOf (_Just . re _nullable . folded) permittedExtensions
|
||||||
|
|
||||||
multiFileField :: Handler (Set FileId) -> Field Handler (Source Handler (Either FileId File))
|
fileUploadForm :: Bool -- ^ Required?
|
||||||
|
-> (Bool -> FieldSettings UniWorX) -- ^ given @unpackZips@ generate `FieldSettings` in the case of `UploadAny`
|
||||||
|
-> UploadMode -> AForm Handler (Maybe (Source Handler File))
|
||||||
|
fileUploadForm isReq mkFs = \case
|
||||||
|
NoUpload
|
||||||
|
-> pure Nothing
|
||||||
|
UploadAny{..}
|
||||||
|
-> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt isReq) (zipFileField unpackZips extensionRestriction) (mkFs unpackZips) Nothing
|
||||||
|
UploadSpecific{..}
|
||||||
|
-> mergeFileSources <$> sequenceA (map specificFileForm . Set.toList $ toNullable specificFiles)
|
||||||
|
where
|
||||||
|
specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe (Source Handler File))
|
||||||
|
specificFileForm spec@UploadSpecificFile{..}
|
||||||
|
= bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) specificFileRequired (specificFileField spec) (fsl specificFileLabel) Nothing
|
||||||
|
|
||||||
|
mergeFileSources :: [Maybe (Source Handler File)] -> Maybe (Source Handler File)
|
||||||
|
mergeFileSources (catMaybes -> sources) = case sources of
|
||||||
|
[] -> Nothing
|
||||||
|
fs -> Just $ sequence_ fs
|
||||||
|
|
||||||
|
multiFileField' :: Source Handler (Either FileId File) -- ^ Permitted files in same format as produced by `multiFileField`
|
||||||
|
-> Field Handler (Source Handler (Either FileId File))
|
||||||
|
multiFileField' permittedFiles = multiFileField . runConduit $ permittedFiles .| C.mapMaybe (preview _Left) .| C.foldMap Set.singleton
|
||||||
|
|
||||||
|
multiFileField :: Handler (Set FileId) -- ^ Set of files that may be submitted by id-reference
|
||||||
|
-> Field Handler (Source Handler (Either FileId File))
|
||||||
multiFileField permittedFiles' = Field{..}
|
multiFileField permittedFiles' = Field{..}
|
||||||
where
|
where
|
||||||
fieldEnctype = Multipart
|
fieldEnctype = Multipart
|
||||||
|
|||||||
@ -279,8 +279,9 @@ submissionMultiArchive (Set.toList -> ids) = do
|
|||||||
execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid)) ->
|
execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid)) ->
|
||||||
tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid)
|
tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid)
|
||||||
|
|
||||||
setContentDisposition' $ Just "submissions.zip"
|
archiveName <- ap getMessageRender $ pure MsgSubmissionArchiveName
|
||||||
(<* cleanup) . respondSource "application/zip" . transPipe (runDBRunner dbrunner) $ do
|
setContentDisposition' $ Just ((addExtension `on` unpack) archiveName extensionZip)
|
||||||
|
(<* cleanup) . respondSource typeZip . transPipe (runDBRunner dbrunner) $ do
|
||||||
let
|
let
|
||||||
fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId)) -> Source (YesodDB UniWorX) File
|
fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId)) -> Source (YesodDB UniWorX) File
|
||||||
fileEntitySource' (rating, Entity submissionID Submission{..},(shn,csh,ssh,tid)) = do
|
fileEntitySource' (rating, Entity submissionID Submission{..},(shn,csh,ssh,tid)) = do
|
||||||
|
|||||||
@ -2,7 +2,8 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
|
||||||
module Handler.Utils.Zip
|
module Handler.Utils.Zip
|
||||||
( ZipError(..)
|
( typeZip, extensionZip
|
||||||
|
, ZipError(..)
|
||||||
, ZipInfo(..)
|
, ZipInfo(..)
|
||||||
, produceZip
|
, produceZip
|
||||||
, consumeZip
|
, consumeZip
|
||||||
@ -27,6 +28,16 @@ import Data.Time.LocalTime (localTimeToUTC, utcToLocalTime)
|
|||||||
|
|
||||||
import Data.List (dropWhileEnd)
|
import Data.List (dropWhileEnd)
|
||||||
|
|
||||||
|
import qualified Data.Map as Map
|
||||||
|
|
||||||
|
|
||||||
|
typeZip :: ContentType
|
||||||
|
typeZip = "application/zip"
|
||||||
|
|
||||||
|
extensionZip :: Extension
|
||||||
|
extensionZip = fromMaybe "zip" $ listToMaybe [ ext | (ext, mime) <- Map.toList mimeMap, mime == typeZip ]
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
instance Default ZipInfo where
|
instance Default ZipInfo where
|
||||||
def = ZipInfo
|
def = ZipInfo
|
||||||
@ -95,7 +106,7 @@ modifyFileTitle f = mapC $ \x@File{..} -> x{ fileTitle = f fileTitle }
|
|||||||
-- Takes FileInfo and if it is a ZIP-Archive, extract files, otherwiese yield fileinfo
|
-- Takes FileInfo and if it is a ZIP-Archive, extract files, otherwiese yield fileinfo
|
||||||
sourceFiles :: (MonadLogger m, MonadResource m, MonadThrow m, MonadIO m) => FileInfo -> Source m File
|
sourceFiles :: (MonadLogger m, MonadResource m, MonadThrow m, MonadIO m) => FileInfo -> Source m File
|
||||||
sourceFiles fInfo
|
sourceFiles fInfo
|
||||||
| mimeType == "application/zip" = do
|
| ((==) `on` simpleContentType) mimeType typeZip = do
|
||||||
$logInfoS "sourceFiles" "Unpacking ZIP"
|
$logInfoS "sourceFiles" "Unpacking ZIP"
|
||||||
fileSource fInfo =$= void consumeZip
|
fileSource fInfo =$= void consumeZip
|
||||||
| otherwise = do
|
| otherwise = do
|
||||||
|
|||||||
@ -34,8 +34,11 @@ import Text.Shakespeare.Text (st)
|
|||||||
import Control.Monad.Trans.Reader (mapReaderT)
|
import Control.Monad.Trans.Reader (mapReaderT)
|
||||||
import Control.Monad.Except (MonadError(..))
|
import Control.Monad.Except (MonadError(..))
|
||||||
import Utils (exceptT, allM, whenIsJust, guardM)
|
import Utils (exceptT, allM, whenIsJust, guardM)
|
||||||
|
import Utils.Lens (_NoUpload)
|
||||||
import Utils.DB (getKeyBy)
|
import Utils.DB (getKeyBy)
|
||||||
|
|
||||||
|
import Control.Lens
|
||||||
|
|
||||||
import Numeric.Natural
|
import Numeric.Natural
|
||||||
|
|
||||||
import qualified Net.IP as IP
|
import qualified Net.IP as IP
|
||||||
@ -398,6 +401,50 @@ customMigrations = Map.fromListWith (>>)
|
|||||||
updateTransactionInfo _ = return ()
|
updateTransactionInfo _ = return ()
|
||||||
runConduit $ getLogEntries .| C.mapM_ updateTransactionInfo
|
runConduit $ getLogEntries .| C.mapM_ updateTransactionInfo
|
||||||
)
|
)
|
||||||
|
, ( AppliedMigrationKey [migrationVersion|16.0.0|] [version|17.0.0|]
|
||||||
|
, do
|
||||||
|
whenM (tableExists "allocation_course") $ do
|
||||||
|
vals <- [sqlQQ| SELECT "course", "instructions", "application_text", "application_files", "ratings_visible" FROM "allocation_course"; |]
|
||||||
|
|
||||||
|
whenM (tableExists "course") $ do
|
||||||
|
[executeQQ|
|
||||||
|
ALTER TABLE "course" ADD COLUMN "applications_required" boolean not null default #{False}, ADD COLUMN "applications_instructions" varchar null, ADD COLUMN "applications_text" boolean not null default #{False}, ADD COLUMN "applications_files" jsonb not null default #{NoUpload}, ADD COLUMN "applications_ratings_visible" boolean not null default #{False};
|
||||||
|
ALTER TABLE "course" ALTER COLUMN "applications_required" DROP DEFAULT, ALTER COLUMN "applications_text" DROP DEFAULT, ALTER COLUMN "applications_files" DROP DEFAULT, ALTER COLUMN "applications_ratings_visible" DROP DEFAULT;
|
||||||
|
|]
|
||||||
|
|
||||||
|
forM_ vals $ \(cid :: CourseId, Single applicationsInstructions :: Single (Maybe Html), Single applicationsText :: Single Bool, Single applicationsFiles :: Single UploadMode, Single applicationsRatingsVisible :: Single Bool) -> do
|
||||||
|
let appRequired = applicationsText || isn't _NoUpload applicationsFiles
|
||||||
|
[executeQQ|
|
||||||
|
UPDATE "course" SET ("applications_required", "applications_instructions", "applications_text", "applications_files", "applications_ratings_visible") = (#{appRequired}, #{applicationsInstructions}, #{applicationsText}, #{applicationsFiles}, #{applicationsRatingsVisible}) WHERE "id" = #{cid};
|
||||||
|
|]
|
||||||
|
|
||||||
|
[executeQQ|
|
||||||
|
ALTER TABLE "allocation_course" DROP COLUMN "instructions", DROP COLUMN "application_text", DROP COLUMN "application_files", DROP COLUMN "ratings_visible";
|
||||||
|
|]
|
||||||
|
|
||||||
|
whenM ((&&) <$> tableExists "allocation_course_file" <*> (not <$> tableExists "course_app_instruction_file")) $ do
|
||||||
|
[executeQQ|
|
||||||
|
CREATe TABLE "course_app_instruction_file"("id" SERIAL8 PRIMARY KEY UNIQUE,"course" INT8 NOT NULL,"file" INT8 NOT NULL);
|
||||||
|
ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "unique_course_app_instruction_file" UNIQUE("course","file");
|
||||||
|
ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "course_app_instruction_file_course_fkey" FOREIGN KEY("course") REFERENCES "course"("id");
|
||||||
|
ALTER TABLE "course_app_instruction_file" ADD CONSTRAINT "course_app_instruction_file_file_fkey" FOREIGN KEY("file") REFERENCES "file"("id");
|
||||||
|
|]
|
||||||
|
|
||||||
|
let getFileEntries = rawQuery [st|SELECT "allocation_course_file"."id", "allocation_course"."course", "allocation_course_file"."file" FROM "allocation_course_file" INNER JOIN "allocation_course" ON "allocation_course"."id" = "allocation_course_file"."allocation_course"|] []
|
||||||
|
moveFileEntry [fromPersistValue -> Right (acfId :: Int64), fromPersistValue -> Right (cid :: CourseId), fromPersistValue -> Right (fid :: FileId)] =
|
||||||
|
[executeQQ|
|
||||||
|
INSERT INTO "course_app_instruction_file" ("course", "file") VALUES (#{cid}, #{fid});
|
||||||
|
DELETE FROM "allocation_course_file" WHERE "id" = #{acfId};
|
||||||
|
|]
|
||||||
|
moveFileEntry _ = return ()
|
||||||
|
runConduit $ getFileEntries .| C.mapM_ moveFileEntry
|
||||||
|
tableDropEmpty "allocation_course_file"
|
||||||
|
|
||||||
|
whenM (tableExists "allocation_application") $
|
||||||
|
tableDropEmpty "allocation_application"
|
||||||
|
whenM (tableExists "allocation_application_file") $
|
||||||
|
tableDropEmpty "allocation_application_file"
|
||||||
|
)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@ -45,6 +45,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
|
|||||||
| AuthCourseRegistered
|
| AuthCourseRegistered
|
||||||
| AuthTutorialRegistered
|
| AuthTutorialRegistered
|
||||||
| AuthExamRegistered
|
| AuthExamRegistered
|
||||||
|
| AuthExamResult
|
||||||
| AuthParticipant
|
| AuthParticipant
|
||||||
| AuthTime
|
| AuthTime
|
||||||
| AuthAllocationTime
|
| AuthAllocationTime
|
||||||
|
|||||||
@ -54,6 +54,9 @@ data Icon
|
|||||||
| IconSFTSolution -- for SheetFileType only
|
| IconSFTSolution -- for SheetFileType only
|
||||||
| IconSFTMarking -- for SheetFileType only
|
| IconSFTMarking -- for SheetFileType only
|
||||||
| IconEmail
|
| IconEmail
|
||||||
|
| IconRegisterTemplate
|
||||||
|
| IconApplyTrue
|
||||||
|
| IconApplyFalse
|
||||||
deriving (Eq, Ord, Enum, Bounded, Show, Read)
|
deriving (Eq, Ord, Enum, Bounded, Show, Read)
|
||||||
|
|
||||||
iconText :: Icon -> Text
|
iconText :: Icon -> Text
|
||||||
@ -82,6 +85,9 @@ iconText = \case
|
|||||||
IconSFTSolution -> "exclamation-circle" -- for SheetFileType only
|
IconSFTSolution -> "exclamation-circle" -- for SheetFileType only
|
||||||
IconSFTMarking -> "check-circle" -- for SheetFileType only
|
IconSFTMarking -> "check-circle" -- for SheetFileType only
|
||||||
IconEmail -> "envelope"
|
IconEmail -> "envelope"
|
||||||
|
IconRegisterTemplate -> "file-alt"
|
||||||
|
IconApplyTrue -> "file-alt"
|
||||||
|
IconApplyFalse -> "trash"
|
||||||
|
|
||||||
instance Universe Icon
|
instance Universe Icon
|
||||||
instance Finite Icon
|
instance Finite Icon
|
||||||
@ -150,6 +156,10 @@ iconEnrol :: Bool -> Markup
|
|||||||
iconEnrol True = icon IconEnrolTrue
|
iconEnrol True = icon IconEnrolTrue
|
||||||
iconEnrol False = icon IconEnrolFalse
|
iconEnrol False = icon IconEnrolFalse
|
||||||
|
|
||||||
|
iconApply :: Bool -> Markup
|
||||||
|
iconApply True = icon IconApplyTrue
|
||||||
|
iconApply False = icon IconApplyFalse
|
||||||
|
|
||||||
iconExamRegister :: Bool -> Markup
|
iconExamRegister :: Bool -> Markup
|
||||||
iconExamRegister True = icon IconExamRegisterTrue
|
iconExamRegister True = icon IconExamRegisterTrue
|
||||||
iconExamRegister False = icon IconExamRegisterFalse
|
iconExamRegister False = icon IconExamRegisterFalse
|
||||||
|
|||||||
@ -123,6 +123,7 @@ makePrisms ''HandlerContents
|
|||||||
|
|
||||||
makePrisms ''ErrorResponse
|
makePrisms ''ErrorResponse
|
||||||
|
|
||||||
|
makePrisms ''UploadMode
|
||||||
makeLenses_ ''UploadMode
|
makeLenses_ ''UploadMode
|
||||||
|
|
||||||
makeLenses_ ''SubmissionMode
|
makeLenses_ ''SubmissionMode
|
||||||
|
|||||||
@ -79,13 +79,38 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
|
|||||||
<div>
|
<div>
|
||||||
\ <em>Achtung:</em>
|
\ <em>Achtung:</em>
|
||||||
\ Abmeldung nur bis #{dereg} erlaubt.
|
\ Abmeldung nur bis #{dereg} erlaubt.
|
||||||
|
$maybe aInst <- courseApplicationsInstructions course
|
||||||
|
<dt .deflist__dt>
|
||||||
|
$if courseApplicationsRequired course
|
||||||
|
_{MsgCourseApplicationInstructionsApplication}
|
||||||
|
$else
|
||||||
|
_{MsgCourseApplicationInstructionsRegistration}
|
||||||
|
<dd .deflist__dd>
|
||||||
|
<div>
|
||||||
|
#{aInst}
|
||||||
|
$if hasApplicationTemplate
|
||||||
|
<p>
|
||||||
|
<a href=@{CourseR tid ssh csh CRegisterTemplateR}>
|
||||||
|
#{iconRegisterTemplate} #
|
||||||
|
$if courseApplicationsRequired course
|
||||||
|
_{MsgCourseApplicationTemplateApplication}
|
||||||
|
$else
|
||||||
|
_{MsgCourseApplicationTemplateRegistration}
|
||||||
$if registrationOpen || isJust mRegAt
|
$if registrationOpen || isJust mRegAt
|
||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
|
_{MsgCourseRegistration}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
<div .course__registration>
|
<div .course__registration>
|
||||||
$if registrationOpen
|
$if registrationOpen
|
||||||
$# regForm is defined through templates/widgets/registerForm
|
$# regForm is defined through templates/widgets/registerForm
|
||||||
^{regForm}
|
^{regForm}
|
||||||
|
$if isJust mApplication && courseApplicationsRequired course
|
||||||
|
<p>
|
||||||
|
_{MsgCourseApplicationDeleteToEdit}
|
||||||
|
$else
|
||||||
|
$if isJust mRegAt
|
||||||
|
<p>
|
||||||
|
_{MsgCourseRegistrationDeleteToEdit}
|
||||||
$maybe date <- mRegAt
|
$maybe date <- mRegAt
|
||||||
_{MsgRegisteredSince} #{date}
|
_{MsgRegisteredSince} #{date}
|
||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
|
|||||||
5
templates/course/login-to-register.hamlet
Normal file
5
templates/course/login-to-register.hamlet
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
$newline never
|
||||||
|
$if courseApplicationsRequired course
|
||||||
|
_{MsgCourseLoginToApply}
|
||||||
|
$else
|
||||||
|
_{MsgCourseLoginToRegister}
|
||||||
@ -420,6 +420,11 @@ fillDb = do
|
|||||||
, courseDeregisterUntil = Nothing
|
, courseDeregisterUntil = Nothing
|
||||||
, courseRegisterSecret = Nothing
|
, courseRegisterSecret = Nothing
|
||||||
, courseMaterialFree = True
|
, courseMaterialFree = True
|
||||||
|
, courseApplicationsRequired = False
|
||||||
|
, courseApplicationsInstructions = Nothing
|
||||||
|
, courseApplicationsText = False
|
||||||
|
, courseApplicationsFiles = NoUpload
|
||||||
|
, courseApplicationsRatingsVisible = False
|
||||||
}
|
}
|
||||||
insert_ $ CourseEdit jost now ffp
|
insert_ $ CourseEdit jost now ffp
|
||||||
void . insert $ DegreeCourse ffp sdBsc sdInf
|
void . insert $ DegreeCourse ffp sdBsc sdInf
|
||||||
@ -452,6 +457,11 @@ fillDb = do
|
|||||||
, courseDeregisterUntil = Nothing
|
, courseDeregisterUntil = Nothing
|
||||||
, courseRegisterSecret = Nothing
|
, courseRegisterSecret = Nothing
|
||||||
, courseMaterialFree = True
|
, courseMaterialFree = True
|
||||||
|
, courseApplicationsRequired = False
|
||||||
|
, courseApplicationsInstructions = Nothing
|
||||||
|
, courseApplicationsText = False
|
||||||
|
, courseApplicationsFiles = NoUpload
|
||||||
|
, courseApplicationsRatingsVisible = False
|
||||||
}
|
}
|
||||||
insert_ $ CourseEdit fhamann now eip
|
insert_ $ CourseEdit fhamann now eip
|
||||||
void . insert' $ DegreeCourse eip sdBsc sdInf
|
void . insert' $ DegreeCourse eip sdBsc sdInf
|
||||||
@ -470,6 +480,11 @@ fillDb = do
|
|||||||
, courseDeregisterUntil = Nothing
|
, courseDeregisterUntil = Nothing
|
||||||
, courseRegisterSecret = Nothing
|
, courseRegisterSecret = Nothing
|
||||||
, courseMaterialFree = True
|
, courseMaterialFree = True
|
||||||
|
, courseApplicationsRequired = False
|
||||||
|
, courseApplicationsInstructions = Nothing
|
||||||
|
, courseApplicationsText = False
|
||||||
|
, courseApplicationsFiles = NoUpload
|
||||||
|
, courseApplicationsRatingsVisible = False
|
||||||
}
|
}
|
||||||
insert_ $ CourseEdit fhamann now ixd
|
insert_ $ CourseEdit fhamann now ixd
|
||||||
void . insert' $ DegreeCourse ixd sdBsc sdInf
|
void . insert' $ DegreeCourse ixd sdBsc sdInf
|
||||||
@ -488,6 +503,11 @@ fillDb = do
|
|||||||
, courseDeregisterUntil = Nothing
|
, courseDeregisterUntil = Nothing
|
||||||
, courseRegisterSecret = Nothing
|
, courseRegisterSecret = Nothing
|
||||||
, courseMaterialFree = True
|
, courseMaterialFree = True
|
||||||
|
, courseApplicationsRequired = False
|
||||||
|
, courseApplicationsInstructions = Nothing
|
||||||
|
, courseApplicationsText = False
|
||||||
|
, courseApplicationsFiles = NoUpload
|
||||||
|
, courseApplicationsRatingsVisible = False
|
||||||
}
|
}
|
||||||
insert_ $ CourseEdit fhamann now ux3
|
insert_ $ CourseEdit fhamann now ux3
|
||||||
void . insert' $ DegreeCourse ux3 sdBsc sdInf
|
void . insert' $ DegreeCourse ux3 sdBsc sdInf
|
||||||
@ -506,6 +526,11 @@ fillDb = do
|
|||||||
, courseDeregisterUntil = Nothing
|
, courseDeregisterUntil = Nothing
|
||||||
, courseRegisterSecret = Nothing
|
, courseRegisterSecret = Nothing
|
||||||
, courseMaterialFree = True
|
, courseMaterialFree = True
|
||||||
|
, courseApplicationsRequired = False
|
||||||
|
, courseApplicationsInstructions = Nothing
|
||||||
|
, courseApplicationsText = False
|
||||||
|
, courseApplicationsFiles = NoUpload
|
||||||
|
, courseApplicationsRatingsVisible = False
|
||||||
}
|
}
|
||||||
insert_ $ CourseEdit jost now pmo
|
insert_ $ CourseEdit jost now pmo
|
||||||
void . insert $ DegreeCourse pmo sdBsc sdInf
|
void . insert $ DegreeCourse pmo sdBsc sdInf
|
||||||
@ -662,6 +687,11 @@ fillDb = do
|
|||||||
, courseDeregisterUntil = Nothing
|
, courseDeregisterUntil = Nothing
|
||||||
, courseRegisterSecret = Just "dbs"
|
, courseRegisterSecret = Just "dbs"
|
||||||
, courseMaterialFree = False
|
, courseMaterialFree = False
|
||||||
|
, courseApplicationsRequired = False
|
||||||
|
, courseApplicationsInstructions = Nothing
|
||||||
|
, courseApplicationsText = False
|
||||||
|
, courseApplicationsFiles = NoUpload
|
||||||
|
, courseApplicationsRatingsVisible = False
|
||||||
}
|
}
|
||||||
insert_ $ CourseEdit gkleen now dbs
|
insert_ $ CourseEdit gkleen now dbs
|
||||||
void . insert' $ DegreeCourse dbs sdBsc sdInf
|
void . insert' $ DegreeCourse dbs sdBsc sdInf
|
||||||
|
|||||||
Reference in New Issue
Block a user