Merge branch 'master' into exam-office
This commit is contained in:
Gregor Kleen
commit
517da054b1
34
CHANGELOG.md
34
CHANGELOG.md
@ -2,6 +2,40 @@
|
||||
|
||||
All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
|
||||
|
||||
## [6.10.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.9.0...v6.10.0) (2019-09-13)
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* **exams:** notifications wrt. registration ([ae27ff0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/ae27ff0))
|
||||
|
||||
|
||||
|
||||
## [6.9.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.8.0...v6.9.0) (2019-09-12)
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* **users:** allow customisation of displayed email address ([2f38278](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/2f38278)), closes [#459](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/459)
|
||||
* **users:** allow customisation of userDisplayName ([a85f317](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a85f317)), closes [#346](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/346)
|
||||
|
||||
|
||||
|
||||
## [6.8.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.7.0...v6.8.0) (2019-09-12)
|
||||
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* **allocations:** better explain capped allocation bounds ([a890e34](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/a890e34))
|
||||
|
||||
|
||||
### Features
|
||||
|
||||
* **allocations:** allow changing course capacity during allocation ([83e1c94](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/83e1c94))
|
||||
* **allocations:** show bounds on assignments due to allocation ([91b249e](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/91b249e))
|
||||
|
||||
|
||||
|
||||
## [6.7.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v6.6.0...v6.7.0) (2019-09-12)
|
||||
|
||||
|
||||
|
||||
@ -3,7 +3,6 @@ import { Utility } from '../../core/utility';
|
||||
import moment from 'moment';
|
||||
|
||||
const KEYCODE_ESCAPE = 27;
|
||||
const Z_INDEX_MODAL = 9999;
|
||||
|
||||
// INTERNAL (Uni2work specific) formats for formatting dates and/or times
|
||||
const FORM_DATE_FORMAT = {
|
||||
@ -140,16 +139,6 @@ export class Datepicker {
|
||||
// initialize tail.datetime (datepicker) instance
|
||||
this.datepickerInstance = datetime(this._element, { ...datepickerGlobalConfig, ...datepickerConfig });
|
||||
|
||||
// append the datepicker element (dt) to the form
|
||||
this._element.form.appendChild(this.datepickerInstance.dt);
|
||||
|
||||
// if the input element is in any open modal, increase the z-index of the datepicker and set its position to fixed to avoid repositioning on page scroll
|
||||
// FIXME: instead of setting the position to fixed, use absolute and reposition (decrease left)
|
||||
if (this._element.closest('.modal--open')) {
|
||||
this.datepickerInstance.dt.style.zIndex = Z_INDEX_MODAL;
|
||||
this.datepickerInstance.dt.style.position = 'fixed';
|
||||
}
|
||||
|
||||
// register this datepicker instance with the formID of the given element in the datepicker collection
|
||||
const formID = this._element.form.id;
|
||||
const elemID = this._element.id;
|
||||
|
||||
@ -640,6 +640,7 @@ UserSchoolsTip: Sie erhalten nur institutweite Benachrichtigungen für Institute
|
||||
FormNotifications: Benachrichtigungen
|
||||
FormBehaviour: Verhalten
|
||||
FormCosmetics: Oberfläche
|
||||
FormPersonalAppearance: Öffentliche Daten
|
||||
FormFieldRequiredTip: Gekennzeichnete Pflichtfelder sind immer auszufüllen
|
||||
|
||||
ActiveAuthTags: Aktivierte Authorisierungsprädikate
|
||||
@ -773,6 +774,15 @@ MailExamOfficeExamResultsIntro courseName@Text termDesc@Text examn@ExamName: Ein
|
||||
MailSubjectExamOfficeExamResultsChanged csh@CourseShorthand examn@ExamName: Ergebnisse für #{examn} in #{csh} wurden verändert
|
||||
MailExamOfficeExamResultsChangedIntro courseName@Text termDesc@Text examn@ExamName: Ein Kursverwalter hat Prüfungsleistungen für #{examn} im Kurs #{courseName} (#{termDesc}) verändert.
|
||||
|
||||
MailSubjectExamRegistrationActive csh@CourseShorthand examn@ExamName: Anmeldung für #{examn} in #{csh} ist möglich
|
||||
MailExamRegistrationActiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich nun für #{examn} im Kurs #{courseName} (#{termDesc}) anmelden.
|
||||
|
||||
MailSubjectExamRegistrationSoonInactive csh@CourseShorthand examn@ExamName: Anmeldung für #{examn} in #{csh} ist nur noch kurze Zeit möglich
|
||||
MailExamRegistrationSoonInactiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich bald nicht mehr für #{examn} im Kurs #{courseName} (#{termDesc}) anmelden.
|
||||
|
||||
MailSubjectExamDeregistrationSoonInactive csh@CourseShorthand examn@ExamName: Abmeldung für #{examn} in #{csh} ist nur noch kurze Zeit möglich
|
||||
MailExamDeregistrationSoonInactiveIntro courseName@Text termDesc@Text examn@ExamName: Sie können sich bald nicht mehr von #{examn} im Kurs #{courseName} (#{termDesc}) abmelden.
|
||||
|
||||
MailSubjectSubmissionsUnassigned csh@CourseShorthand sheetName@SheetName: Abgaben zu #{sheetName} in #{csh} konnten nicht verteilt werden
|
||||
MailSubmissionsUnassignedIntro n@Int courseName@Text termDesc@Text sheetName@SheetName: #{n} Abgaben zu #{sheetName} im Kurs #{courseName} (#{termDesc}) konnten nicht automatisiert verteilt werden.
|
||||
|
||||
@ -875,6 +885,9 @@ NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugetei
|
||||
NotificationTriggerCorrectionsNotDistributed: Nicht alle Abgaben eines meiner Übungsblätter konnten einem Korrektor zugeteilt werden
|
||||
NotificationTriggerUserRightsUpdate: Meine Berechtigungen wurden geändert
|
||||
NotificationTriggerUserAuthModeUpdate: Mein Anmelde-Modus wurde geändert
|
||||
NotificationTriggerExamRegistrationActive: Ich kann mich für eine Prüfung anmelden
|
||||
NotificationTriggerExamRegistrationSoonInactive: Ich kann mich bald nicht mehr für eine Prüfung anmelden
|
||||
NotificationTriggerExamDeregistrationSoonInactive: Ich kann mich bald nicht mehr von einer Prüfung abmelden
|
||||
NotificationTriggerExamResult: Ich kann ein neues Prüfungsergebnis einsehen
|
||||
NotificationTriggerAllocationStaffRegister: Ich kann Kurse bei einer neuen Zentralanmeldung eintragen
|
||||
NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldung-Bewerbungen für einen meiner Kurse bewerten
|
||||
@ -1632,9 +1645,16 @@ CourseApplicationNoVeto: Kein Veto
|
||||
CourseApplicationNoRatingPoints: Keine Bewertung
|
||||
CourseApplicationNoRatingComment: Kein Kommentar
|
||||
|
||||
UserDisplayName: Voller Name
|
||||
UserDisplayName: Angezeigter Name
|
||||
UserDisplayNameInvalid: Angezeigter Name erfüllt nicht die Vorgaben
|
||||
UserDisplayNameRules: Vorgaben für den angezeigten Namen
|
||||
UserDisplayNameRulesBelow: Vorgaben für den angezeigten Namen finden sich weiter unten auf der Seite
|
||||
UserMatriculation: Matrikelnummer
|
||||
|
||||
UserDisplayEmail: Angezeigte E-Mail Adresse
|
||||
UserDisplayEmailTip: Diese Adresse wird in öffentlich zugänglichen Teilen des Systems im Zusammenhang mit Ihrem Namen angezeigt. Benachrichtigungen und andere Kommunikation von Uni2work und Nutzern mit erweiterten Rechten erhalten sie stets, unabhängig von dieser Einstellung, an die in Ihren Persönlichen Daten hinterlegte primäre Adresse.
|
||||
UserDisplayEmailChangeSent displayEmail@UserEmail: Anweisungen zum Ändern der angezeigten E-Mail Adresse wurden an „#{displayEmail}” versandt
|
||||
|
||||
SchoolShort: Kürzel
|
||||
SchoolName: Name
|
||||
SchoolLdapOrganisations: Assoziierte LDAP-Fragmente
|
||||
@ -1701,6 +1721,7 @@ AdminUserFirstName: Vorname
|
||||
AdminUserSurname: Nachname
|
||||
AdminUserDisplayName: Anzeige-Name
|
||||
AdminUserEmail: E-Mail Addresse
|
||||
AdminUserDisplayEmail: Anzeige-E-Mail
|
||||
AdminUserIdent: Identifikation
|
||||
AdminUserAuth: Authentifizierung
|
||||
AdminUserMatriculation: Matrikelnummer
|
||||
@ -1708,3 +1729,17 @@ AuthKindLDAP: Campus-Kennung
|
||||
AuthKindPWHash: Uni2work-Kennung
|
||||
UserAdded: Benutzer erfolgreich angelegt
|
||||
UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden
|
||||
|
||||
CourseAllocationsBounds n@Int: Voraussichtliche Zuteilungen durch #{pluralDE n "Zentralanmeldung" "Zentralanmeldungen"}
|
||||
CourseAllocationsBoundCoincide numFirstChoice@Int: Vstl. #{numFirstChoice} Teilnehmer
|
||||
CourseAllocationsBound numApps@Int numFirstChoice@Int: Vstl. zwischen #{numFirstChoice} und #{numApps} Teilnehmer
|
||||
CourseAllocationsBoundCapped: Die obige Anzeige wurde durch die aktuell angegebene Kurskapazität reduziert.
|
||||
CourseAllocationsBoundWarningOpen: Diese Informationen entsprechen nur dem aktuellen Stand der Bewerbungen und können sich noch ändern.
|
||||
|
||||
BtnSetDisplayEmail: E-Mail Adresse setzen
|
||||
UserDisplayEmailChanged: Öffentliche E-Mail Adresse erfolgreich gesetzt
|
||||
TitleChangeUserDisplayEmail: Öffentliche E-Mail Adresse setzen
|
||||
|
||||
MailSubjectChangeUserDisplayEmail: Diese E-Mail Adresse in Uni2work veröffentlichen
|
||||
MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer möchte „#{displayEmail}“ als öffentliche Adresse, assoziiert mit sich selbst, angeben. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte!
|
||||
MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail Adresse in Uni2work veröffentlichen
|
||||
|
||||
@ -9,9 +9,10 @@
|
||||
--
|
||||
User json -- Each Uni2work user has a corresponding row in this table; created upon first login.
|
||||
surname UserSurname -- Display user names always through 'nameWidget displayName surname'
|
||||
displayName UserDisplayName -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained)
|
||||
email (CI Text) -- Case-insensitive eMail address
|
||||
ident (CI Text) -- Case-insensitive user-identifier
|
||||
displayName UserDisplayName
|
||||
displayEmail UserEmail
|
||||
email UserEmail -- Case-insensitive eMail address
|
||||
ident UserIdent -- Case-insensitive user-identifier
|
||||
authentication AuthenticationMode -- 'AuthLDAP' or ('AuthPWHash'+password-hash)
|
||||
lastAuthentication UTCTime Maybe -- last login date
|
||||
created UTCTime default=now()
|
||||
|
||||
2
package-lock.json
generated
2
package-lock.json
generated
@ -1,6 +1,6 @@
|
||||
{
|
||||
"name": "uni2work",
|
||||
"version": "6.7.0",
|
||||
"version": "6.10.0",
|
||||
"lockfileVersion": 1,
|
||||
"requires": true,
|
||||
"dependencies": {
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{
|
||||
"name": "uni2work",
|
||||
"version": "6.7.0",
|
||||
"version": "6.10.0",
|
||||
"description": "",
|
||||
"keywords": [],
|
||||
"author": "",
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
name: uniworx
|
||||
version: 6.7.0
|
||||
version: 6.10.0
|
||||
|
||||
dependencies:
|
||||
# Due to a bug in GHC 8.0.1, we block its usage
|
||||
@ -137,6 +137,7 @@ dependencies:
|
||||
- memory
|
||||
- pqueue
|
||||
- deepseq
|
||||
- multiset
|
||||
|
||||
other-extensions:
|
||||
- GeneralizedNewtypeDeriving
|
||||
|
||||
1
routes
1
routes
@ -71,6 +71,7 @@
|
||||
/user ProfileR GET POST !free
|
||||
/user/profile ProfileDataR GET !free
|
||||
/user/authpreds AuthPredsR GET POST !free
|
||||
/user/set-display-email SetDisplayEmailR GET POST !free
|
||||
|
||||
/exam-office ExamOfficeR !exam-office:
|
||||
/ EOExamsR GET
|
||||
|
||||
@ -67,6 +67,7 @@ import qualified Control.Monad.Catch as C
|
||||
import Handler.Utils.StudyFeatures
|
||||
import Handler.Utils.SchoolLdap
|
||||
import Handler.Utils.ExamOffice.Exam.Auth
|
||||
import Handler.Utils.Profile
|
||||
import Utils.Form
|
||||
import Utils.Sheet
|
||||
import Utils.SystemMessage
|
||||
@ -1803,9 +1804,10 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb InstanceR = return ("Identifikation", Nothing)
|
||||
|
||||
|
||||
breadcrumb ProfileR = return ("User" , Just HomeR)
|
||||
breadcrumb ProfileDataR = return ("Profile" , Just ProfileR)
|
||||
breadcrumb AuthPredsR = return ("Authentifizierung", Just ProfileR)
|
||||
breadcrumb ProfileR = return ("Einstellungen" , Just HomeR)
|
||||
breadcrumb SetDisplayEmailR = return ("Öffentliche E-Mail Adresse", Just ProfileR)
|
||||
breadcrumb ProfileDataR = return ("Persönliche Daten", Just ProfileR)
|
||||
breadcrumb AuthPredsR = return ("Authorisierung" , Just ProfileR)
|
||||
|
||||
breadcrumb TermShowR = return ("Semester" , Just HomeR)
|
||||
breadcrumb TermCurrentR = return ("Aktuell" , Just TermShowR)
|
||||
@ -3142,7 +3144,7 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
let
|
||||
userMatrikelnummer' = fold [ v | (k, v) <- ldapData, k == ldapUserMatriculation ]
|
||||
userEmail' = fold [ v | (k, v) <- ldapData, k == ldapUserEmail ]
|
||||
userDisplayName' = fold [ v | (k, v) <- ldapData, k == ldapUserDisplayName ]
|
||||
userDisplayName'' = fold [ v | (k, v) <- ldapData, k == ldapUserDisplayName ]
|
||||
userFirstName' = fold [ v | (k, v) <- ldapData, k == ldapUserFirstName ]
|
||||
userSurname' = fold [ v | (k, v) <- ldapData, k == ldapUserSurname ]
|
||||
userTitle' = fold [ v | (k, v) <- ldapData, k == ldapUserTitle ]
|
||||
@ -3158,10 +3160,10 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
-> return $ mk userEmail
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidEmail
|
||||
userDisplayName <- if
|
||||
| [bs] <- userDisplayName'
|
||||
, Right userDisplayName <- Text.decodeUtf8' bs
|
||||
-> return userDisplayName
|
||||
userDisplayName' <- if
|
||||
| [bs] <- userDisplayName''
|
||||
, Right userDisplayName' <- Text.decodeUtf8' bs
|
||||
-> return userDisplayName'
|
||||
| otherwise
|
||||
-> throwM CampusUserInvalidDisplayName
|
||||
userFirstName <- if
|
||||
@ -3208,17 +3210,23 @@ upsertCampusUser ldapData Creds{..} = do
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Just now
|
||||
, userDisplayName = userDisplayName'
|
||||
, userDisplayEmail = userEmail
|
||||
, ..
|
||||
}
|
||||
userUpdate = [ UserMatrikelnummer =. userMatrikelnummer
|
||||
, UserDisplayName =. userDisplayName
|
||||
-- , UserDisplayName =. userDisplayName
|
||||
, UserFirstName =. userFirstName
|
||||
, UserSurname =. userSurname
|
||||
, UserTitle =. userTitle
|
||||
, UserEmail =. userEmail
|
||||
, UserLastLdapSynchronisation =. Just now
|
||||
] ++
|
||||
[ UserLastAuthentication =. Just now | not isDummy ]
|
||||
|
||||
user@(Entity userId _) <- upsertBy (UniqueAuthentication $ mk credsIdent) newUser userUpdate
|
||||
user@(Entity userId userRec) <- upsertBy (UniqueAuthentication $ mk credsIdent) newUser userUpdate
|
||||
unless (validDisplayName userTitle userFirstName userSurname $ userDisplayName userRec) $
|
||||
update userId [ UserDisplayName =. userDisplayName' ]
|
||||
|
||||
let
|
||||
userStudyFeatures = fmap concat . forM userStudyFeatures' $ parseStudyFeatures userId now
|
||||
|
||||
@ -209,8 +209,8 @@ embedRenderMessage ''UniWorX ''CourseApplicationsTableCsvException id
|
||||
getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
getCApplicationsR = postCApplicationsR
|
||||
postCApplicationsR tid ssh csh = do
|
||||
table <- runDB $ do
|
||||
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
(table, allocationsBounds) <- runDB $ do
|
||||
Entity cid Course{..} <- getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
|
||||
csvName <- getMessageRender <*> pure (MsgCourseApplicationsTableCsvName tid ssh csh)
|
||||
let
|
||||
@ -531,10 +531,46 @@ postCApplicationsR tid ssh csh = do
|
||||
psValidator = def
|
||||
& defaultSorting [SortAscBy "user-name"]
|
||||
|
||||
dbTableWidget' psValidator DBTable{..}
|
||||
participants <- count [ CourseParticipantCourse ==. cid ]
|
||||
let remainingCapacity = subtract participants <$> courseCapacity
|
||||
|
||||
allocationsBounds' <- E.select . E.from $ \(allocation `E.InnerJoin` allocationCourse) -> do
|
||||
E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
|
||||
E.&&. allocationCourse E.^. AllocationCourseCourse E.==. E.val cid
|
||||
|
||||
let numApps addWhere = E.sub_select . E.from $ \courseApplication -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationCourse E.==. E.val cid
|
||||
E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
|
||||
addWhere courseApplication
|
||||
return E.countRows
|
||||
|
||||
numApps' = numApps . const $ return ()
|
||||
|
||||
numFirstChoice = numApps $ \courseApplication ->
|
||||
E.where_ . E.not_ . E.exists . E.from $ \courseApplication' -> do
|
||||
E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. courseApplication' E.^. CourseApplicationAllocation
|
||||
E.&&. courseApplication E.^. CourseApplicationUser E.==. courseApplication' E.^. CourseApplicationUser
|
||||
E.where_ . E.not_ $ E.isNothing (courseApplication E.^. CourseApplicationAllocationPriority)
|
||||
E.||. E.isNothing (courseApplication' E.^. CourseApplicationAllocationPriority)
|
||||
E.where_ $ courseApplication' E.^. CourseApplicationAllocationPriority E.>. courseApplication E.^. CourseApplicationAllocationPriority
|
||||
|
||||
return (allocation, numApps', numFirstChoice)
|
||||
|
||||
let
|
||||
allocationsBounds = [ (allocation, numApps', numFirstChoice', capped)
|
||||
| (Entity _ allocation, E.Value numApps, E.Value numFirstChoice) <- allocationsBounds'
|
||||
, let numApps' = max 0 $ maybe id min remainingCapacity numApps
|
||||
numFirstChoice' = max 0 $ maybe id min remainingCapacity numFirstChoice
|
||||
capped = numApps' /= numApps
|
||||
|| numFirstChoice' /= numFirstChoice
|
||||
]
|
||||
|
||||
(, allocationsBounds) <$> dbTableWidget' psValidator DBTable{..}
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let title = prependCourseTitle tid ssh csh MsgCourseApplicationsListTitle
|
||||
registrationOpen = maybe True (now <)
|
||||
|
||||
siteLayoutMsg title $ do
|
||||
setTitleI title
|
||||
table
|
||||
$(widgetFile "course/applications-list")
|
||||
|
||||
@ -303,10 +303,11 @@ validateCourse = do
|
||||
prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
|
||||
prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
|
||||
|
||||
fmap join . for prevAllocation $ \Allocation{allocationStaffRegisterTo} -> if
|
||||
fmap join . for prevAllocation $ \Allocation{allocationStaffAllocationTo, allocationRegisterByCourse} -> if
|
||||
| userAdmin
|
||||
-> return Nothing
|
||||
| NTop allocationStaffRegisterTo <= NTop (Just now)
|
||||
| NTop allocationStaffAllocationTo <= NTop (Just now)
|
||||
, NTop allocationRegisterByCourse > NTop (Just now)
|
||||
-> Just . courseCapacity <$> getJust cid
|
||||
| otherwise
|
||||
-> return Nothing
|
||||
|
||||
@ -46,7 +46,7 @@ getCShowR tid ssh csh = do
|
||||
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
|
||||
E.orderBy [ E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName ]
|
||||
return ( lecturer E.^. LecturerType
|
||||
, user E.^. UserEmail, user E.^. UserDisplayName, user E.^. UserSurname)
|
||||
, user E.^. UserDisplayEmail, user E.^. UserDisplayName, user E.^. UserSurname)
|
||||
let partStaff :: (LecturerType, UserEmail, Text, Text) -> Either (UserEmail, Text, Text) (UserEmail, Text, Text)
|
||||
partStaff (CourseLecturer ,name,surn,mail) = Right (name,surn,mail)
|
||||
partStaff (_courseAssistant,name,surn,mail) = Left (name,surn,mail)
|
||||
|
||||
@ -3,6 +3,8 @@ module Handler.Profile where
|
||||
import Import
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Profile
|
||||
import Handler.Utils.Tokens
|
||||
|
||||
-- import Colonnade hiding (fromMaybe, singleton)
|
||||
-- import Yesod.Colonnade
|
||||
@ -16,9 +18,13 @@ import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Jobs
|
||||
|
||||
|
||||
data SettingsForm = SettingsForm
|
||||
{ stgMaxFavourties :: Int
|
||||
{ stgDisplayName :: UserDisplayName
|
||||
, stgDisplayEmail :: UserEmail
|
||||
, stgMaxFavourties :: Int
|
||||
, stgTheme :: Theme
|
||||
, stgDateTime :: DateTimeFormat
|
||||
, stgDate :: DateTimeFormat
|
||||
@ -28,6 +34,7 @@ data SettingsForm = SettingsForm
|
||||
, stgSchools :: Set SchoolId
|
||||
, stgNotificationSettings :: NotificationSettings
|
||||
}
|
||||
makeLenses_ ''SettingsForm
|
||||
|
||||
data NotificationTriggerKind
|
||||
= NTKAll
|
||||
@ -57,7 +64,10 @@ instance RenderMessage UniWorX NotificationTriggerKind where
|
||||
makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
|
||||
makeSettingForm template html = do
|
||||
(result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
|
||||
<$ aformSection MsgFormCosmetics
|
||||
<$ aformSection MsgFormPersonalAppearance
|
||||
<*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template)
|
||||
<*> areq (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template)
|
||||
<* aformSection MsgFormCosmetics
|
||||
<*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
|
||||
(fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
|
||||
<*> areq (selectField . return $ mkOptionList themeList)
|
||||
@ -150,30 +160,41 @@ notificationForm template = wFormToAForm $ do
|
||||
= apopt checkBoxField (fslI nt) (flip notificationAllowed nt <$> template)
|
||||
|
||||
ntSection = \case
|
||||
NTSubmissionRatedGraded -> Just NTKCourseParticipant
|
||||
NTSubmissionRated -> Just NTKCourseParticipant
|
||||
NTSheetActive -> Just NTKCourseParticipant
|
||||
NTSheetSoonInactive -> Just NTKCourseParticipant
|
||||
NTSheetInactive -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTCorrectionsAssigned -> Just NTKCorrector
|
||||
NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTUserRightsUpdate -> Just NTKAll
|
||||
NTUserAuthModeUpdate -> Just NTKAll
|
||||
NTExamResult -> Just NTKExamParticipant
|
||||
NTAllocationStaffRegister -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTAllocationAllocation -> Just NTKAllocationStaff
|
||||
NTAllocationRegister -> Just NTKAll
|
||||
NTAllocationOutdatedRatings -> Just NTKAllocationStaff
|
||||
NTAllocationUnratedApplications -> Just NTKAllocationStaff
|
||||
NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice
|
||||
NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice
|
||||
-- _other -> Nothing
|
||||
NTSubmissionRatedGraded -> Just NTKCourseParticipant
|
||||
NTSubmissionRated -> Just NTKCourseParticipant
|
||||
NTSheetActive -> Just NTKCourseParticipant
|
||||
NTSheetSoonInactive -> Just NTKCourseParticipant
|
||||
NTSheetInactive -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTCorrectionsAssigned -> Just NTKCorrector
|
||||
NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTUserRightsUpdate -> Just NTKAll
|
||||
NTUserAuthModeUpdate -> Just NTKAll
|
||||
NTExamRegistrationActive -> Just NTKCourseParticipant
|
||||
NTExamRegistrationSoonInactive -> Just NTKCourseParticipant
|
||||
NTExamDeregistrationSoonInactive -> Just NTKCourseParticipant
|
||||
NTExamResult -> Just NTKExamParticipant
|
||||
NTAllocationStaffRegister -> Just $ NTKFunctionary SchoolLecturer
|
||||
NTAllocationAllocation -> Just NTKAllocationStaff
|
||||
NTAllocationRegister -> Just NTKAll
|
||||
NTAllocationOutdatedRatings -> Just NTKAllocationStaff
|
||||
NTAllocationUnratedApplications -> Just NTKAllocationStaff
|
||||
NTExamOfficeExamResults -> Just $ NTKFunctionary SchoolExamOffice
|
||||
NTExamOfficeExamResultsChanged -> Just $ NTKFunctionary SchoolExamOffice
|
||||
-- _other -> Nothing
|
||||
|
||||
forcedTriggers = [NTUserRightsUpdate, NTUserAuthModeUpdate]
|
||||
|
||||
aFormToWForm $ NotificationSettings <$> sectionedFuncForm ntSection nsForm (fslI MsgNotificationSettings) False
|
||||
|
||||
|
||||
validateSettings :: User -> FormValidator SettingsForm Handler ()
|
||||
validateSettings User{..} = do
|
||||
userDisplayName' <- use _stgDisplayName
|
||||
|
||||
guardValidation MsgUserDisplayNameInvalid $
|
||||
validDisplayName userTitle userFirstName userSurname userDisplayName'
|
||||
|
||||
|
||||
data ButtonResetTokens = BtnResetTokens
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
instance Universe ButtonResetTokens
|
||||
@ -196,7 +217,7 @@ nullaryPathPiece ''ProfileAnchor $ camelToPathPiece' 1
|
||||
getProfileR, postProfileR :: Handler Html
|
||||
getProfileR = postProfileR
|
||||
postProfileR = do
|
||||
(uid, User{..}) <- requireAuthPair
|
||||
(uid, user@User{..}) <- requireAuthPair
|
||||
userSchools <- fmap (setOf $ folded . _Value) . runDB . E.select . E.from $ \school -> do
|
||||
E.where_ . E.exists . E.from $ \userSchool ->
|
||||
E.where_ $ E.not_ (userSchool E.^. UserSchoolIsOptOut)
|
||||
@ -204,7 +225,9 @@ postProfileR = do
|
||||
E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
|
||||
return $ school E.^. SchoolId
|
||||
let settingsTemplate = Just SettingsForm
|
||||
{ stgMaxFavourties = userMaxFavourites
|
||||
{ stgDisplayName = userDisplayName
|
||||
, stgDisplayEmail = userDisplayEmail
|
||||
, stgMaxFavourties = userMaxFavourites
|
||||
, stgTheme = userTheme
|
||||
, stgDateTime = userDateTimeFormat
|
||||
, stgDate = userDateFormat
|
||||
@ -214,19 +237,24 @@ postProfileR = do
|
||||
, stgNotificationSettings = userNotificationSettings
|
||||
, stgWarningDays = userWarningDays
|
||||
}
|
||||
((res,formWidget), formEnctype) <- runFormPost . identifyForm ProfileSettings $ makeSettingForm settingsTemplate
|
||||
((res,formWidget), formEnctype) <- runFormPost . validateForm (validateSettings user) . identifyForm ProfileSettings $ makeSettingForm settingsTemplate
|
||||
|
||||
formResult res $ \SettingsForm{..} -> do
|
||||
runDB $ do
|
||||
update uid [ UserMaxFavourites =. stgMaxFavourties
|
||||
, UserTheme =. stgTheme
|
||||
, UserDateTimeFormat =. stgDateTime
|
||||
, UserDateFormat =. stgDate
|
||||
, UserTimeFormat =. stgTime
|
||||
, UserDownloadFiles =. stgDownloadFiles
|
||||
, UserWarningDays =. stgWarningDays
|
||||
, UserNotificationSettings =. stgNotificationSettings
|
||||
]
|
||||
runDBJobs $ do
|
||||
update uid $
|
||||
[ UserDisplayName =. stgDisplayName
|
||||
, UserMaxFavourites =. stgMaxFavourties
|
||||
, UserTheme =. stgTheme
|
||||
, UserDateTimeFormat =. stgDateTime
|
||||
, UserDateFormat =. stgDate
|
||||
, UserTimeFormat =. stgTime
|
||||
, UserDownloadFiles =. stgDownloadFiles
|
||||
, UserWarningDays =. stgWarningDays
|
||||
, UserNotificationSettings =. stgNotificationSettings
|
||||
] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ]
|
||||
when (stgDisplayEmail /= userDisplayEmail) $ do
|
||||
queueDBJob $ JobChangeUserDisplayEmail uid stgDisplayEmail
|
||||
addMessageI Info $ MsgUserDisplayEmailChangeSent stgDisplayEmail
|
||||
when (stgMaxFavourties < userMaxFavourites) $ do
|
||||
-- prune Favourites to user-defined size
|
||||
oldFavs <- selectKeysList [ CourseFavouriteUser ==. uid]
|
||||
@ -253,7 +281,7 @@ postProfileR = do
|
||||
}
|
||||
[ UserSchoolIsOptOut =. True
|
||||
]
|
||||
addMessageI Info MsgSettingsUpdate
|
||||
addMessageI Success MsgSettingsUpdate
|
||||
redirect $ ProfileR :#: ProfileSettings
|
||||
|
||||
((tokenRes, tokenFormWidget), tokenEnctype) <- runFormPost . identifyForm ProfileResetTokens $ buttonForm
|
||||
@ -287,6 +315,7 @@ postProfileR = do
|
||||
, formAnchor = Just ProfileResetTokens
|
||||
}
|
||||
tokenExplanation = $(i18nWidgetFile "profile/tokenExplanation")
|
||||
displayNameRules = $(i18nWidgetFile "profile/displayNameRules")
|
||||
$(widgetFile "profile/profile")
|
||||
|
||||
|
||||
@ -727,3 +756,43 @@ postUserNotificationR cID = do
|
||||
siteLayoutMsg (MsgNotificationSettingsHeading userDisplayName) $ do
|
||||
setTitleI $ MsgNotificationSettingsHeading userDisplayName
|
||||
formWidget
|
||||
|
||||
|
||||
data ButtonSetDisplayEmail = BtnSetDisplayEmail
|
||||
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
|
||||
instance Universe ButtonSetDisplayEmail
|
||||
instance Finite ButtonSetDisplayEmail
|
||||
|
||||
nullaryPathPiece ''ButtonSetDisplayEmail $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''ButtonSetDisplayEmail id
|
||||
|
||||
instance Button UniWorX ButtonSetDisplayEmail where
|
||||
btnClasses _ = [BCIsButton]
|
||||
|
||||
|
||||
getSetDisplayEmailR, postSetDisplayEmailR :: Handler Html
|
||||
getSetDisplayEmailR = postSetDisplayEmailR
|
||||
postSetDisplayEmailR = do
|
||||
uid <- requireAuthId
|
||||
mDisplayEmail <- requireCurrentTokenRestrictions
|
||||
|
||||
case mDisplayEmail of
|
||||
Nothing -> invalidArgs ["Bearer token required"]
|
||||
Just displayEmail -> do
|
||||
((btnRes, btnView), btnEnc) <- runFormPost $ formEmbedJwtPost buttonForm
|
||||
let btnView' = wrapForm btnView def
|
||||
{ formSubmit = FormNoSubmit
|
||||
, formAction = Just $ SomeRoute SetDisplayEmailR
|
||||
, formEncoding = btnEnc
|
||||
}
|
||||
|
||||
formResult btnRes $ \case
|
||||
BtnSetDisplayEmail -> do
|
||||
runDB $
|
||||
update uid [UserDisplayEmail =. displayEmail]
|
||||
addMessageI Success MsgUserDisplayEmailChanged
|
||||
redirect ProfileR
|
||||
|
||||
siteLayoutMsg MsgTitleChangeUserDisplayEmail $ do
|
||||
setTitleI MsgTitleChangeUserDisplayEmail
|
||||
$(i18nWidgetFile "set-display-email")
|
||||
|
||||
@ -16,6 +16,7 @@ data AdminUserForm = AdminUserForm
|
||||
, aufFirstName :: Text
|
||||
, aufSurname :: UserSurname
|
||||
, aufDisplayName :: UserDisplayName
|
||||
, aufDisplayEmail :: UserEmail
|
||||
, aufMatriculation :: Maybe UserMatriculation
|
||||
, aufEmail :: UserEmail
|
||||
, aufIdent :: UserIdent
|
||||
@ -44,6 +45,7 @@ adminUserForm template = renderAForm FormStandard
|
||||
<*> areq (textField & cfStrip) (fslI MsgAdminUserFirstName) (aufFirstName <$> template)
|
||||
<*> areq (textField & cfStrip) (fslI MsgAdminUserSurname) (aufSurname <$> template)
|
||||
<*> areq (textField & cfStrip) (fslI MsgAdminUserDisplayName) (aufDisplayName <$> template)
|
||||
<*> areq (emailField & cfCI) (fslI MsgAdminUserDisplayEmail) (aufDisplayEmail <$> template)
|
||||
<*> aopt (textField & cfStrip) (fslI MsgAdminUserMatriculation) (aufMatriculation <$> template)
|
||||
<*> areq (emailField & cfCI) (fslI MsgAdminUserEmail) (aufEmail <$> template)
|
||||
<*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent) (aufIdent <$> template)
|
||||
@ -77,6 +79,7 @@ postAdminUserAddR = do
|
||||
, userLastAuthentication = Nothing
|
||||
, userEmail = aufEmail
|
||||
, userDisplayName = aufDisplayName
|
||||
, userDisplayEmail = aufDisplayEmail
|
||||
, userFirstName = aufFirstName
|
||||
, userSurname = aufSurname
|
||||
, userTitle = aufTitle
|
||||
|
||||
@ -981,15 +981,16 @@ sectionedFuncForm mkSection mkForm FieldSettings{fsName = _, fsAttrs = _, ..} is
|
||||
aFormToWForm $ Map.union <$> wFormToAForm (pure res) <*> acc
|
||||
|
||||
funcFieldView :: (FormResult (k -> v), Widget) -> MForm m (FormResult (k -> v), [FieldView UniWorX])
|
||||
funcFieldView (res, fvInput) = do
|
||||
funcFieldView (res, formView) = do
|
||||
mr <- getMessageRender
|
||||
fvId <- maybe newIdent return fsId
|
||||
let fvLabel = toHtml $ mr fsLabel
|
||||
fvTooltip = fmap (toHtml . mr) fsTooltip
|
||||
fvRequired = isRequired
|
||||
fvErrors
|
||||
| FormFailure (err:_) <- res = Just $ toHtml err
|
||||
| otherwise = Nothing
|
||||
fvId <- maybe newIdent return fsId
|
||||
fvInput = $(widgetFile "widgets/fields/funcField")
|
||||
return (res, pure FieldView{..})
|
||||
-- areq nsField (fslI MsgNotificationSettings) (stgNotficationSettings <$> template)
|
||||
|
||||
|
||||
35
src/Handler/Utils/Profile.hs
Normal file
35
src/Handler/Utils/Profile.hs
Normal file
@ -0,0 +1,35 @@
|
||||
module Handler.Utils.Profile
|
||||
( validDisplayName
|
||||
) where
|
||||
|
||||
import Import.NoFoundation
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.MultiSet as MultiSet
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Data.Char as Char
|
||||
|
||||
|
||||
validDisplayName :: Maybe UserTitle
|
||||
-> UserFirstName
|
||||
-> UserSurname
|
||||
-> UserDisplayName
|
||||
-> Bool
|
||||
validDisplayName (fmap Text.strip -> mTitle) (Text.strip -> fName) (Text.strip -> sName) (Text.strip -> dName)
|
||||
= and [ dNameFrags `MultiSet.isSubsetOf` MultiSet.unions [titleFrags, fNameFrags, sNameFrags]
|
||||
, sName `Text.isInfixOf` dName
|
||||
, all ((<= 1) . Text.length) . filter (Text.any Char.isSpace) $ Text.groupBy ((==) `on` Char.isSpace) dName
|
||||
, dNameLetters `Set.isSubsetOf` Set.unions [titleLetters, fNameLetters, sNameLetters, addLetters]
|
||||
]
|
||||
where
|
||||
titleFrags = MultiSet.fromList $ maybe [] Text.words mTitle
|
||||
fNameFrags = MultiSet.fromList $ Text.words fName
|
||||
sNameFrags = MultiSet.fromList $ Text.words sName
|
||||
dNameFrags = MultiSet.fromList $ Text.words dName
|
||||
|
||||
titleLetters = Set.fromList $ maybe [] unpack mTitle
|
||||
fNameLetters = Set.fromList $ unpack fName
|
||||
sNameLetters = Set.fromList $ unpack sName
|
||||
dNameLetters = Set.fromList $ unpack dName
|
||||
addLetters = Set.fromList [' ']
|
||||
@ -68,6 +68,7 @@ import Jobs.Handler.SendPasswordReset
|
||||
import Jobs.Handler.TransactionLog
|
||||
import Jobs.Handler.SynchroniseLdap
|
||||
import Jobs.Handler.PruneInvitations
|
||||
import Jobs.Handler.ChangeUserDisplayEmail
|
||||
|
||||
import Jobs.HealthReport
|
||||
|
||||
|
||||
@ -212,17 +212,46 @@ determineCrontab = execWriterT $ do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. E.val nExam
|
||||
return . E.max_ $ examResult E.^. ExamResultLastChanged
|
||||
|
||||
case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of
|
||||
[E.Value (NTop (Just ts))] ->
|
||||
whenIsJust examVisibleFrom $ \visibleFrom -> do
|
||||
case over (mapped . _Value) ((max `on` NTop) examFinished) newestResult of
|
||||
[E.Value (NTop (Just ts))] ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationExamResult{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom ts
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left appNotificationExpiration
|
||||
}
|
||||
_other -> return ()
|
||||
|
||||
whenIsJust examRegisterFrom $ \registerFrom ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationExamResult{..})
|
||||
(JobCtlQueue $ JobQueueNotification NotificationExamRegistrationActive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ ts
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ $ max visibleFrom registerFrom
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Left $ 14 * nominalDay
|
||||
, cronNotAfter = maybe (Left appNotificationExpiration) (Right . CronTimestamp . utcToLocalTimeTZ appTZ) examRegisterTo
|
||||
}
|
||||
whenIsJust ((,) <$> examRegisterFrom <*> examRegisterTo) $ \(registerFrom, registerTo) ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationExamRegistrationSoonInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) registerTo
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ registerTo
|
||||
}
|
||||
whenIsJust ((,) <$> examRegisterFrom <*> examDeregisterUntil) $ \(registerFrom, deregisterUntil) ->
|
||||
tell $ HashMap.singleton
|
||||
(JobCtlQueue $ JobQueueNotification NotificationExamDeregistrationSoonInactive{..})
|
||||
Cron
|
||||
{ cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max visibleFrom . max registerFrom $ addUTCTime (-nominalDay) deregisterUntil
|
||||
, cronRepeat = CronRepeatOnChange
|
||||
, cronRateLimit = appNotificationRateLimit
|
||||
, cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ deregisterUntil
|
||||
}
|
||||
_other -> return ()
|
||||
|
||||
case examClosed of
|
||||
Just close -> do
|
||||
|
||||
29
src/Jobs/Handler/ChangeUserDisplayEmail.hs
Normal file
29
src/Jobs/Handler/ChangeUserDisplayEmail.hs
Normal file
@ -0,0 +1,29 @@
|
||||
module Jobs.Handler.ChangeUserDisplayEmail
|
||||
( dispatchJobChangeUserDisplayEmail
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils.Mail
|
||||
import qualified Data.HashSet as HashSet
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Text.Hamlet
|
||||
|
||||
dispatchJobChangeUserDisplayEmail :: UserId -> UserEmail -> Handler ()
|
||||
dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = do
|
||||
token <- tokenRestrict SetDisplayEmailR jDisplayEmail <$> bearerToken jUser (Just $ HashSet.singleton SetDisplayEmailR) Nothing Nothing Nothing
|
||||
jwt <- encodeToken token
|
||||
let
|
||||
setDisplayEmailUrl :: SomeRoute UniWorX
|
||||
setDisplayEmailUrl = SomeRoute (SetDisplayEmailR, [(toPathPiece GetBearer, toPathPiece jwt)])
|
||||
setDisplayEmailUrl' <- toTextUrl setDisplayEmailUrl
|
||||
|
||||
user@User{..} <- runDB $ getJust jUser
|
||||
|
||||
userMailT jUser $ do
|
||||
_mailTo .= pure (userAddress user & _addressEmail .~ CI.original jDisplayEmail)
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI MsgMailSubjectChangeUserDisplayEmail
|
||||
addAlternatives $
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/changeUserDisplayEmail.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
@ -75,6 +75,29 @@ determineNotificationCandidates NotificationUserRightsUpdate{..} = do
|
||||
return . nub $ affectedUser <> affectedAdmins
|
||||
determineNotificationCandidates NotificationUserAuthModeUpdate{..}
|
||||
= selectList [UserId ==. nUser] []
|
||||
determineNotificationCandidates NotificationExamRegistrationActive{..} =
|
||||
E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
|
||||
E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
|
||||
E.where_ $ exam E.^. ExamId E.==. E.val nExam
|
||||
E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||
E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
||||
return user
|
||||
determineNotificationCandidates NotificationExamRegistrationSoonInactive{..} =
|
||||
E.select . E.from $ \(exam `E.InnerJoin` courseParticipant `E.InnerJoin` user) -> do
|
||||
E.on $ courseParticipant E.^. CourseParticipantUser E.==. user E.^. UserId
|
||||
E.on $ courseParticipant E.^. CourseParticipantCourse E.==. exam E.^. ExamCourse
|
||||
E.where_ $ exam E.^. ExamId E.==. E.val nExam
|
||||
E.where_ . E.not_ . E.exists . E.from $ \examRegistration ->
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||
E.&&. examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
||||
return user
|
||||
determineNotificationCandidates NotificationExamDeregistrationSoonInactive{..} =
|
||||
E.select . E.from $ \(examRegistration `E.InnerJoin` user) -> do
|
||||
E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. E.val nExam
|
||||
return user
|
||||
determineNotificationCandidates notif@NotificationExamResult{..} = do
|
||||
lastExec <- fmap (fmap $ cronLastExecTime . entityVal) . getBy . UniqueCronLastExec . toJSON $ JobQueueNotification notif
|
||||
E.select . E.from $ \(examResult `E.InnerJoin` user) -> E.distinctOnOrderBy [E.asc $ user E.^. UserId] $ do
|
||||
@ -183,18 +206,21 @@ classifyNotification NotificationSubmissionRated{..} = do
|
||||
return $ case sheetType of
|
||||
NotGraded -> NTSubmissionRated
|
||||
_other -> NTSubmissionRatedGraded
|
||||
classifyNotification NotificationSheetActive{} = return NTSheetActive
|
||||
classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive
|
||||
classifyNotification NotificationSheetInactive{} = return NTSheetInactive
|
||||
classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
|
||||
classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed
|
||||
classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate
|
||||
classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate
|
||||
classifyNotification NotificationExamResult{} = return NTExamResult
|
||||
classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
|
||||
classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
|
||||
classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
|
||||
classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
|
||||
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
|
||||
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
|
||||
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
|
||||
classifyNotification NotificationSheetActive{} = return NTSheetActive
|
||||
classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactive
|
||||
classifyNotification NotificationSheetInactive{} = return NTSheetInactive
|
||||
classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
|
||||
classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed
|
||||
classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate
|
||||
classifyNotification NotificationUserAuthModeUpdate{} = return NTUserAuthModeUpdate
|
||||
classifyNotification NotificationExamRegistrationActive{} = return NTExamRegistrationActive
|
||||
classifyNotification NotificationExamRegistrationSoonInactive{} = return NTExamRegistrationSoonInactive
|
||||
classifyNotification NotificationExamDeregistrationSoonInactive{} = return NTExamDeregistrationSoonInactive
|
||||
classifyNotification NotificationExamResult{} = return NTExamResult
|
||||
classifyNotification NotificationAllocationStaffRegister{} = return NTAllocationStaffRegister
|
||||
classifyNotification NotificationAllocationAllocation{} = return NTAllocationAllocation
|
||||
classifyNotification NotificationAllocationRegister{} = return NTAllocationRegister
|
||||
classifyNotification NotificationAllocationOutdatedRatings{} = return NTAllocationOutdatedRatings
|
||||
classifyNotification NotificationAllocationUnratedApplications{} = return NTAllocationUnratedApplications
|
||||
classifyNotification NotificationExamOfficeExamResults{} = return NTExamOfficeExamResults
|
||||
classifyNotification NotificationExamOfficeExamResultsChanged{} = return NTExamOfficeExamResultsChanged
|
||||
|
||||
@ -14,6 +14,7 @@ import Jobs.Handler.SendNotification.CorrectionsAssigned
|
||||
import Jobs.Handler.SendNotification.CorrectionsNotDistributed
|
||||
import Jobs.Handler.SendNotification.UserRightsUpdate
|
||||
import Jobs.Handler.SendNotification.UserAuthModeUpdate
|
||||
import Jobs.Handler.SendNotification.ExamActive
|
||||
import Jobs.Handler.SendNotification.ExamResult
|
||||
import Jobs.Handler.SendNotification.Allocation
|
||||
import Jobs.Handler.SendNotification.ExamOffice
|
||||
|
||||
78
src/Jobs/Handler/SendNotification/ExamActive.hs
Normal file
78
src/Jobs/Handler/SendNotification/ExamActive.hs
Normal file
@ -0,0 +1,78 @@
|
||||
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
|
||||
|
||||
module Jobs.Handler.SendNotification.ExamActive
|
||||
( dispatchNotificationExamRegistrationActive
|
||||
, dispatchNotificationExamRegistrationSoonInactive
|
||||
, dispatchNotificationExamDeregistrationSoonInactive
|
||||
) where
|
||||
|
||||
import Import
|
||||
|
||||
import Handler.Utils.Mail
|
||||
import Jobs.Handler.SendNotification.Utils
|
||||
|
||||
import Text.Hamlet
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
dispatchNotificationExamRegistrationActive :: ExamId -> UserId -> Handler ()
|
||||
dispatchNotificationExamRegistrationActive nExam jRecipient = userMailT jRecipient $ do
|
||||
(Course{..}, Exam{..}) <- liftHandlerT . runDB $ do
|
||||
exam <- getJust nExam
|
||||
course <- belongsToJust examCourse exam
|
||||
return (course, exam)
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectExamRegistrationActive courseShorthand examName
|
||||
|
||||
MsgRenderer mr <- getMailMsgRenderer
|
||||
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
|
||||
tid = courseTerm
|
||||
ssh = courseSchool
|
||||
csh = courseShorthand
|
||||
examn = examName
|
||||
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
addAlternatives $
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationActive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
|
||||
dispatchNotificationExamRegistrationSoonInactive :: ExamId -> UserId -> Handler ()
|
||||
dispatchNotificationExamRegistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do
|
||||
(Course{..}, Exam{..}) <- liftHandlerT . runDB $ do
|
||||
exam <- getJust nExam
|
||||
course <- belongsToJust examCourse exam
|
||||
return (course, exam)
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectExamRegistrationSoonInactive courseShorthand examName
|
||||
|
||||
MsgRenderer mr <- getMailMsgRenderer
|
||||
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
|
||||
tid = courseTerm
|
||||
ssh = courseSchool
|
||||
csh = courseShorthand
|
||||
examn = examName
|
||||
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
addAlternatives $
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/examRegistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
|
||||
dispatchNotificationExamDeregistrationSoonInactive :: ExamId -> UserId -> Handler ()
|
||||
dispatchNotificationExamDeregistrationSoonInactive nExam jRecipient = userMailT jRecipient $ do
|
||||
(Course{..}, Exam{..}) <- liftHandlerT . runDB $ do
|
||||
exam <- getJust nExam
|
||||
course <- belongsToJust examCourse exam
|
||||
return (course, exam)
|
||||
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
||||
setSubjectI $ MsgMailSubjectExamDeregistrationSoonInactive courseShorthand examName
|
||||
|
||||
MsgRenderer mr <- getMailMsgRenderer
|
||||
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
|
||||
tid = courseTerm
|
||||
ssh = courseSchool
|
||||
csh = courseShorthand
|
||||
examn = examName
|
||||
|
||||
editNotifications <- mkEditNotifications jRecipient
|
||||
|
||||
addAlternatives $
|
||||
providePreferredAlternative ($(ihamletFile "templates/mail/examDeregistrationSoonInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|
||||
@ -64,6 +64,9 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
|
||||
}
|
||||
| JobSynchroniseLdapUser { jUser :: UserId
|
||||
}
|
||||
| JobChangeUserDisplayEmail { jUser :: UserId
|
||||
, jDisplayEmail :: UserEmail
|
||||
}
|
||||
deriving (Eq, Ord, Show, Read, Generic, Typeable)
|
||||
data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
|
||||
| NotificationSheetActive { nSheet :: SheetId }
|
||||
@ -73,6 +76,9 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
|
||||
| NotificationCorrectionsNotDistributed { nSheet :: SheetId }
|
||||
| NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }
|
||||
| NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode }
|
||||
| NotificationExamRegistrationActive { nExam :: ExamId }
|
||||
| NotificationExamRegistrationSoonInactive { nExam :: ExamId }
|
||||
| NotificationExamDeregistrationSoonInactive { nExam :: ExamId }
|
||||
| NotificationExamResult { nExam :: ExamId }
|
||||
| NotificationAllocationStaffRegister { nAllocation :: AllocationId }
|
||||
| NotificationAllocationRegister { nAllocation :: AllocationId }
|
||||
|
||||
@ -485,6 +485,14 @@ customMigrations = Map.fromListWith (>>)
|
||||
DELETE FROM "invitation" WHERE "for"->'junction' = '"UserLecturer"';
|
||||
|]
|
||||
)
|
||||
, ( AppliedMigrationKey [migrationVersion|19.0.0|] [version|20.0.0|]
|
||||
, whenM (tableExists "user") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "user" ADD COLUMN IF NOT EXISTS "display_email" citext;
|
||||
UPDATE "user" SET "display_email" = "email" WHERE "display_email" IS NULL;
|
||||
ALTER TABLE "user" ALTER COLUMN "display_email" SET NOT NULL;
|
||||
|]
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -18,8 +18,10 @@ type Points = Centi
|
||||
|
||||
type Email = Text
|
||||
|
||||
type UserDisplayName = Text
|
||||
type UserTitle = Text
|
||||
type UserFirstName = Text
|
||||
type UserSurname = Text
|
||||
type UserDisplayName = Text
|
||||
type UserMatriculation = Text
|
||||
|
||||
type StudyDegreeName = Text
|
||||
|
||||
@ -31,6 +31,9 @@ data NotificationTrigger
|
||||
| NTCorrectionsNotDistributed
|
||||
| NTUserRightsUpdate
|
||||
| NTUserAuthModeUpdate
|
||||
| NTExamRegistrationActive
|
||||
| NTExamRegistrationSoonInactive
|
||||
| NTExamDeregistrationSoonInactive
|
||||
| NTExamResult
|
||||
| NTAllocationStaffRegister
|
||||
| NTAllocationAllocation
|
||||
@ -67,6 +70,7 @@ instance Default NotificationSettings where
|
||||
defaultOff :: HashSet NotificationTrigger
|
||||
defaultOff = HashSet.fromList
|
||||
[ NTSheetSoonInactive
|
||||
, NTExamRegistrationSoonInactive
|
||||
]
|
||||
|
||||
instance ToJSON NotificationSettings where
|
||||
|
||||
22
templates/course/applications-list.hamlet
Normal file
22
templates/course/applications-list.hamlet
Normal file
@ -0,0 +1,22 @@
|
||||
$newline never
|
||||
$if not (null allocationsBounds)
|
||||
<h2>_{MsgCourseAllocationsBounds (length allocationsBounds)}
|
||||
<dl .deflist>
|
||||
$forall (Allocation{allocationName, allocationRegisterTo}, numApps, numFirstChoice, capped) <- allocationsBounds
|
||||
<dt .deflist__dt>
|
||||
#{allocationName}
|
||||
<dd .deflist__dd>
|
||||
<p>
|
||||
$if numApps == numFirstChoice
|
||||
_{MsgCourseAllocationsBoundCoincide numFirstChoice}
|
||||
$else
|
||||
_{MsgCourseAllocationsBound numApps numFirstChoice}
|
||||
$if capped
|
||||
<p .bound_explanation>
|
||||
_{MsgCourseAllocationsBoundCapped}
|
||||
$if registrationOpen allocationRegisterTo
|
||||
<p .bound_explanation>
|
||||
_{MsgCourseAllocationsBoundWarningOpen}
|
||||
|
||||
<h2>_{MsgMenuCourseApplications}
|
||||
^{table}
|
||||
4
templates/course/applications-list.lucius
Normal file
4
templates/course/applications-list.lucius
Normal file
@ -0,0 +1,4 @@
|
||||
.bound_explanation {
|
||||
color: var(--color-fontsec);
|
||||
font-style: italic;
|
||||
}
|
||||
@ -1,5 +1,19 @@
|
||||
$newline never
|
||||
<dl .deflist>
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2019 09 13}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
<li>Benachrichtigungen bzgl. Klausur An- und Abmeldung
|
||||
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2019 09 12}
|
||||
<dd .deflist__dd>
|
||||
<ul>
|
||||
<li>Abschätzung der durch Zentralanmeldung benötigten Kurskapazität
|
||||
<li>Anpassbare angezeigte Namen
|
||||
<li>Anpassbare angezeigte E-Mail Adressen
|
||||
|
||||
<dt .deflist__dt>
|
||||
^{formatGregorianW 2019 09 05}
|
||||
<dd .deflist__dd>
|
||||
|
||||
9
templates/i18n/profile/displayNameRules/de.hamlet
Normal file
9
templates/i18n/profile/displayNameRules/de.hamlet
Normal file
@ -0,0 +1,9 @@
|
||||
$newline never
|
||||
<ul>
|
||||
<li>Der Nachname („#{userSurname}“) muss im angezeigten Namen vollständig enthalten sein.
|
||||
$maybe title <- userTitle
|
||||
<li>Der angezeigte Name muss vollständig aus Fragmenten des akademischen Titels („#{title}“), des Vornamens („#{userFirstName}“) und des Nachnamens („#{userSurname}“) bestehen.
|
||||
$nothing
|
||||
<li>Der angezeigte Name muss vollständig aus Fragmenten des Vornamens („#{userFirstName}“) und des Nachnamens („#{userSurname}“) bestehen.
|
||||
<li>Der angezeigte Name darf keine mehrfachen Leerzeichen enthalten.
|
||||
<li>Der angezeigter Name darf keine Sonderzeichen enthalten, die in keinem der Namensbestandteile vorkommen.
|
||||
4
templates/i18n/set-display-email/de.hamlet
Normal file
4
templates/i18n/set-display-email/de.hamlet
Normal file
@ -0,0 +1,4 @@
|
||||
$newline never
|
||||
<p>
|
||||
Möchten Sie die, öffentlich im Zusammenhang mit Ihrem Namen angezeigte, E-Mail Adresse wirklich auf „#{displayEmail}“ setzen?
|
||||
^{btnView'}
|
||||
19
templates/mail/changeUserDisplayEmail.hamlet
Normal file
19
templates/mail/changeUserDisplayEmail.hamlet
Normal file
@ -0,0 +1,19 @@
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<style>
|
||||
h1 {
|
||||
font-size: 1.25em;
|
||||
font-variant: small-caps;
|
||||
font-weight: normal;
|
||||
}
|
||||
<body>
|
||||
<h1>
|
||||
_{MsgMailTitleChangeUserDisplayEmail userDisplayName}
|
||||
<p>
|
||||
_{MsgMailIntroChangeUserDisplayEmail jDisplayEmail}
|
||||
<p>
|
||||
<a href=#{setDisplayEmailUrl'}>
|
||||
_{MsgBtnSetDisplayEmail}
|
||||
18
templates/mail/examDeregistrationSoonInactive.hamlet
Normal file
18
templates/mail/examDeregistrationSoonInactive.hamlet
Normal file
@ -0,0 +1,18 @@
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<style>
|
||||
h1 {
|
||||
font-size: 1.25em;
|
||||
font-variant: small-caps;
|
||||
font-weight: normal;
|
||||
}
|
||||
<body>
|
||||
<h1>
|
||||
_{MsgMailExamDeregistrationSoonInactiveIntro (CI.original courseName) termDesc examName}
|
||||
<p>
|
||||
<a href=@{CExamR tid ssh csh examn EShowR}>
|
||||
#{examName}
|
||||
^{editNotifications}
|
||||
18
templates/mail/examRegistrationActive.hamlet
Normal file
18
templates/mail/examRegistrationActive.hamlet
Normal file
@ -0,0 +1,18 @@
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<style>
|
||||
h1 {
|
||||
font-size: 1.25em;
|
||||
font-variant: small-caps;
|
||||
font-weight: normal;
|
||||
}
|
||||
<body>
|
||||
<h1>
|
||||
_{MsgMailExamRegistrationActiveIntro (CI.original courseName) termDesc examName}
|
||||
<p>
|
||||
<a href=@{CExamR tid ssh csh examn EShowR}>
|
||||
#{examName}
|
||||
^{editNotifications}
|
||||
18
templates/mail/examRegistrationSoonInactive.hamlet
Normal file
18
templates/mail/examRegistrationSoonInactive.hamlet
Normal file
@ -0,0 +1,18 @@
|
||||
$newline never
|
||||
\<!doctype html>
|
||||
<html>
|
||||
<head>
|
||||
<meta charset="UTF-8">
|
||||
<style>
|
||||
h1 {
|
||||
font-size: 1.25em;
|
||||
font-variant: small-caps;
|
||||
font-weight: normal;
|
||||
}
|
||||
<body>
|
||||
<h1>
|
||||
_{MsgMailExamRegistrationSoonInactiveIntro (CI.original courseName) termDesc examName}
|
||||
<p>
|
||||
<a href=@{CExamR tid ssh csh examn EShowR}>
|
||||
#{examName}
|
||||
^{editNotifications}
|
||||
@ -1,6 +1,10 @@
|
||||
$newline never
|
||||
<section>
|
||||
^{settingsForm}
|
||||
<section>
|
||||
<h3>_{MsgUserDisplayNameRules}
|
||||
<p>
|
||||
^{displayNameRules}
|
||||
<section>
|
||||
^{tokenExplanation}
|
||||
<p>
|
||||
|
||||
3
templates/widgets/fields/funcField.hamlet
Normal file
3
templates/widgets/fields/funcField.hamlet
Normal file
@ -0,0 +1,3 @@
|
||||
$newline never
|
||||
<div ##{fvId <> "-wrapper"}>
|
||||
^{formView}
|
||||
4
templates/widgets/fields/funcField.lucius
Normal file
4
templates/widgets/fields/funcField.lucius
Normal file
@ -0,0 +1,4 @@
|
||||
##{fvId <> "-wrapper"} {
|
||||
max-height: 75vh;
|
||||
overflow: auto;
|
||||
}
|
||||
@ -93,6 +93,7 @@ fillDb = do
|
||||
, userTokensIssuedAfter = Just now
|
||||
, userMatrikelnummer = Nothing
|
||||
, userEmail = "G.Kleen@campus.lmu.de"
|
||||
, userDisplayEmail = "gregor.kleen@ifi.lmu.de"
|
||||
, userDisplayName = "Gregor Kleen"
|
||||
, userSurname = "Kleen"
|
||||
, userFirstName = "Gregor Julius Arthur"
|
||||
@ -116,6 +117,7 @@ fillDb = do
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userMatrikelnummer = Nothing
|
||||
, userEmail = "felix.hamann@campus.lmu.de"
|
||||
, userDisplayEmail = "felix.hamann@campus.lmu.de"
|
||||
, userDisplayName = "Felix Hamann"
|
||||
, userSurname = "Hamann"
|
||||
, userFirstName = "Felix"
|
||||
@ -139,6 +141,7 @@ fillDb = do
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userMatrikelnummer = Nothing
|
||||
, userEmail = "jost@tcs.ifi.lmu.de"
|
||||
, userDisplayEmail = "jost@tcs.ifi.lmu.de"
|
||||
, userDisplayName = "Steffen Jost"
|
||||
, userSurname = "Jost"
|
||||
, userFirstName = "Steffen"
|
||||
@ -162,6 +165,7 @@ fillDb = do
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userMatrikelnummer = Just "1299"
|
||||
, userEmail = "max@campus.lmu.de"
|
||||
, userDisplayEmail = "max@max.com"
|
||||
, userDisplayName = "Max Musterstudent"
|
||||
, userSurname = "Musterstudent"
|
||||
, userFirstName = "Max"
|
||||
@ -185,6 +189,7 @@ fillDb = do
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userMatrikelnummer = Just "999"
|
||||
, userEmail = "tester@campus.lmu.de"
|
||||
, userDisplayEmail = "tina@tester.example"
|
||||
, userDisplayName = "Tina Tester"
|
||||
, userSurname = "von Terror"
|
||||
, userFirstName = "Sabrina"
|
||||
@ -208,6 +213,7 @@ fillDb = do
|
||||
, userTokensIssuedAfter = Nothing
|
||||
, userMatrikelnummer = Nothing
|
||||
, userEmail = "vaupel.sarah@campus.lmu.de"
|
||||
, userDisplayEmail = "vaupel.sarah@campus.lmu.de"
|
||||
, userDisplayName = "Sarah Vaupel"
|
||||
, userSurname = "Vaupel"
|
||||
, userFirstName = "Sarah"
|
||||
|
||||
@ -80,6 +80,7 @@ instance Arbitrary User where
|
||||
userTokensIssuedAfter <- arbitrary
|
||||
userMatrikelnummer <- fmap pack . assertM' (not . null) <$> listOf (elements ['0'..'9'])
|
||||
userEmail <- CI.mk . decodeUtf8 . Email.toByteString <$> arbitrary
|
||||
userDisplayEmail <- CI.mk . decodeUtf8 . Email.toByteString <$> arbitrary
|
||||
|
||||
names <- listOf1 $ pack . getPrintableString <$> arbitrary
|
||||
userDisplayName <- unwords <$> sublistOf names
|
||||
|
||||
@ -116,6 +116,7 @@ createUser adjUser = do
|
||||
userTokensIssuedAfter = Nothing
|
||||
userIdent = "dummy@example.invalid"
|
||||
userEmail = "dummy@example.invalid"
|
||||
userDisplayEmail = "dummy@example.invalid"
|
||||
userDisplayName = "Dummy Example"
|
||||
userSurname = "Example"
|
||||
userFirstName = "Dummy"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user