Merge branch 'schools' into 'master'

School/User-Overhaul Closes #320 See merge request !263
2019-08-29 17:35:27 +02:00 · 2019-08-29 17:35:27 +02:00 · 0427658314
commit 0427658314
parent 533b21fc9d 90aef6423f
60 changed files with 1137 additions and 399 deletions
--- a/config/settings.yml
+++ b/config/settings.yml
@ -41,6 +41,9 @@ health-check-delay-notify: "_env:HEALTHCHECK_DELAY_NOTIFY:true"
 health-check-http: "_env:HEALTHCHECK_HTTP:true" # Can we assume, that we can reach ourselves under APPROOT via HTTP (reverse proxies or firewalls might prevent this)?
 health-check-active-job-executors-timeout: "_env:HEALTHCHECK_ACTIVE_JOB_EXECUTORS_TIMEOUT:5"

+synchronise-ldap-users-within: "_env:SYNCHRONISE_LDAP_WITHIN:604800"
+synchronise-ldap-users-interval: "_env:SYNCHRONISE_LDAP_INTERVAL:3600"
+
 log-settings:
  detailed:      "_env:DETAILED_LOGGING:false"
  all:           "_env:LOG_ALL:false"
--- a/frontend/src/services/html-helpers/html-helpers.js
+++ b/frontend/src/services/html-helpers/html-helpers.js
@ -24,7 +24,7 @@ export class HtmlHelpers {
  }

  _prefixIds(element, idPrefix) {
-    const idAttrs = ['id', 'for', 'data-conditional-input', 'data-modal-trigger'];
+    const idAttrs = ['id', 'for', 'list', 'data-conditional-input', 'data-modal-trigger'];

    idAttrs.forEach((attr) => {
      Array.from(element.querySelectorAll('[' + attr + ']')).forEach((input) => {
--- a/frontend/src/utils/mass-input/mass-input.js
+++ b/frontend/src/utils/mass-input/mass-input.js
@ -1,5 +1,6 @@
 import { Utility } from '../../core/utility';
 import { Datepicker } from '../form/datepicker';
+import './mass-input.scss';

 const MASS_INPUT_CELL_SELECTOR = '.massinput__cell';
 const MASS_INPUT_ADD_CELL_SELECTOR = '.massinput__cell--add';
--- a/frontend/src/utils/mass-input/mass-input.scss
+++ b/frontend/src/utils/mass-input/mass-input.scss
@ -0,0 +1,18 @@
+.massinput-list__wrapper, .massinput-list__cell {
+  display: grid;
+  grid: auto / auto 50px;
+  max-width: 600px;
+  grid-gap: 7px;
+}
+
+.massinput-list__field {
+  grid-column: 1;
+}
+
+.massinput-list__add, .massinput-list__delete {
+  grid-column: 2;
+}
+
+.massinput-list__cell {
+  grid-column: 1 / 3;
+}
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -581,7 +581,7 @@ RatingFilesUpdated: Korrigierte Dateien überschrieben
 RatingNotUnicode uexc@UnicodeException: Bewertungsdatei nicht in UTF-8 kodiert: #{tshow uexc}
 RatingMissingSeparator: Präambel der Bewertungsdatei konnte nicht identifziert werden
 RatingMultiple: Bewertungen enthält mehrere Punktzahlen für die gleiche Abgabe
-RatingInvalid parseErr@String: Bewertungspunktzahl konnte nicht als Zahl verstanden werden: #{parseErr}
+RatingInvalid parseErr@Text: Bewertungspunktzahl konnte nicht als Zahl verstanden werden: #{parseErr}
 RatingFileIsDirectory: Unerwarteter Fehler: Datei ist unerlaubterweise ein Verzeichnis
 RatingNegative: Bewertungspunkte dürfen nicht negativ sein
 RatingExceedsMax: Bewertung übersteigt die erlaubte Maximalpunktzahl
@ -615,7 +615,8 @@ TutorsFor n@Int: #{pluralDE n "Tutor" "Tutoren"}
 CorrectorsFor n@Int: #{pluralDE n "Korrektor" "Korrektoren"}
 ForSchools n@Int: für #{pluralDE n "Institut" "Institute"}
 UserListTitle: Komprehensive Benutzerliste
-AccessRightsSaved: Berechtigungsänderungen wurden gespeichert.
+AccessRightsSaved: Berechtigungen erfolgreich verändert
+AccessRightsNotChanged: Berechtigungen wurden nicht verändert

 LecturersForN n@Int: #{pluralDE n "Dozent" "Dozenten"}

@ -628,6 +629,8 @@ DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern a
 WarningDays: Fristen-Vorschau
 WarningDaysTip: Wie viele Tage im Voraus sollen Fristen von Klausuren etc. auf Ihrer Startseite angezeigt werden?
 NotificationSettings: Erwünschte Benachrichtigungen
+UserSchools: Relevante Institute
+UserSchoolsTip: Sie erhalten nur institutweite Benachrichtigungen für Institute, die hier ausgewählt sind.
 FormNotifications: Benachrichtigungen
 FormBehaviour: Verhalten
 FormCosmetics: Oberfläche
@ -662,7 +665,8 @@ CampusUserInvalidGivenName: Konnte anhand des Campus-Logins keinen Vornamen ermi
 CampusUserInvalidSurname: Konnte anhand des Campus-Logins keinen Nachname ermitteln
 CampusUserInvalidTitle: Konnte anhand des Campus-Logins keinen akademischen Titel ermitteln
 CampusUserInvalidMatriculation: Konnte anhand des Campus-Logins keine Matrikelnummer ermitteln
-CampusUserInvalidFeaturesOfStudy parseErr@String: Konnte anhand des Campus-Logins keine Matrikelnummer ermitteln: #{parseErr}
+CampusUserInvalidFeaturesOfStudy parseErr@Text: Konnte anhand des Campus-Logins keine Studiengänge ermitteln
+CampusUserInvalidAssociatedSchools parseErr@Text: Konnte anhand des Campus-Logins keine Institute ermitteln

 CorrectorNormal: Normal
 CorrectorMissing: Abwesend
@ -861,6 +865,8 @@ NotificationTriggerKindExamParticipant: Für Prüfungsteilnehmer
 NotificationTriggerKindCorrector: Für Korrektoren
 NotificationTriggerKindLecturer: Für Dozenten
 NotificationTriggerKindAdmin: Für Administratoren
+NotificationTriggerKindExamOffice: Für das Prüfungsamt
+NotificationTriggerKindEvaluation: Für Vorlesungsumfragen

 CorrCreate: Abgaben erstellen
 UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"
@ -1031,6 +1037,8 @@ MenuExamAddMembers: Prüfungsteilnehmer hinzufügen
 MenuLecturerInvite: Dozenten hinzufügen
 MenuAllocationInfo: Hinweise zum Ablauf einer Zentralanmeldung
 MenuCourseApplicationsFiles: Dateien aller Bewerbungen
+MenuSchoolList: Institute
+MenuSchoolNew: Neues Institut anlegen

 AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist, d.h. bis ihr Browser-Cookie abgelaufen ist. Durch Abwahl von Prädikaten kann man sich höchstens temporär aussperren.
 AuthPredsActive: Aktive Authorisierungsprädikate
@ -1489,17 +1497,18 @@ PasswordRepeatInvalid: Wiederholung stimmt nicht mit neuem Passwort überein
 UserPasswordHeadingFor: Passwort ändern für
 PasswordChangedSuccess: Passwort erfolgreich geändert

-LecturerInviteSchool: Institut
-LecturerInviteField: Einzuladende EMail Addressen
-LecturerInviteHeading: Dozenten hinzufügen
+FunctionaryInviteFunction: Funktion
+FunctionaryInviteSchool: Institut
+FunctionaryInviteField: Einzuladende EMail Addressen
+FunctionaryInviteHeading: Institut-Funktionäre hinzufügen

-LecturersInvited n@Int: #{n} #{pluralDE n "Dozent" "Dozenten"} per EMail eingeladen
-LecturersAdded n@Int: #{n} #{pluralDE n "Dozent" "Dozenten"} eingetragen
+FunctionariesInvited n@Int: #{n} #{pluralDE n "Funktionär" "Funktionäre"} per EMail eingeladen
+FunctionariesAdded n@Int: #{n} #{pluralDE n "Funktionär" "Funktionäre"} eingetragen

-MailSubjectSchoolLecturerInvitation school@SchoolName: Einladung zum Dozent für „#{school}“
-MailSchoolLecturerInviteHeading school@SchoolName: Einladung zum Dozent für „#{school}“
-SchoolLecturerInviteExplanation: Sie wurden eingeladen, Dozent für ein Institut zu sein. Sie können, nachdem Sie die Einladung annehmen, eigenständig neue Kurse anlegen.
-SchoolLecturerInvitationAccepted school@SchoolName: Einladung zum Dozent für „#{school}“ angenommen
+MailSubjectSchoolFunctionInvitation school@SchoolName renderedFunction@Text: #{renderedFunction}-Einladung für „#{school}“
+MailSchoolFunctionInviteHeading school@SchoolName renderedFunction@Text: #{renderedFunction}-Einladung für „#{school}“
+SchoolFunctionInviteExplanation renderedFunction@Text: Sie wurden eingeladen, als #{renderedFunction} für ein Institut zu wirken. Sie erhalten, nachdem Sie die Einladung annehmen, erweiterte Rechte innerhalb des Instituts.
+SchoolFunctionInvitationAccepted school@SchoolName renderedFunction@Text: #{renderedFunction}-Einladung zum Dozent für „#{school}“ angenommen

 AllocationActive: Aktiv
 AllocationName: Name
@ -1562,4 +1571,20 @@ CourseApplicationNoRatingPoints: Keine Bewertung
 CourseApplicationNoRatingComment: Kein Kommentar

 UserDisplayName: Voller Name
-UserMatriculation: Matrikelnummer
+UserMatriculation: Matrikelnummer
+
+SchoolShort: Kürzel
+SchoolName: Name
+SchoolLdapOrganisations: Assoziierte LDAP-Fragmente
+SchoolLdapOrganisationsTip: Beim Login via LDAP werden dem Nutzer alle Institute zugeordnet deren assoziierte LDAP-Fragmente im Eintrag des Nutzer gefunden werden
+
+SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst
+SchoolTitle ssh@SchoolId: Institut „#{ssh}“
+TitleSchoolNew: Neues Institut anlegen
+SchoolCreated ssh@SchoolId: #{ssh} erfolgreich angelegt
+SchoolExists ssh@SchoolId: Institut „#{ssh}“ existiert bereits
+
+SchoolAdmin: Admin
+SchoolLecturer: Dozent
+SchoolEvaluation: Kursumfragenverwaltung
+SchoolExamOffice: Prüfungsamt
--- a/models/schools
+++ b/models/schools
@ -6,4 +6,11 @@ School json
    UniqueSchool name
    UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
    Primary shorthand        -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }
-    deriving Eq Show Generic
+    deriving Ord Eq Show Generic
+SchoolLdap
+    school  SchoolId Maybe
+    orgUnit (CI Text)
+    UniqueOrgUnit orgUnit
+SchoolTerms
+    school  SchoolId
+    terms   StudyTermsId
--- a/models/users
+++ b/models/users
@ -14,6 +14,8 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
    ident          (CI Text)                -- Case-insensitive user-identifier
    authentication AuthenticationMode       -- 'AuthLDAP' or ('AuthPWHash'+password-hash)
    lastAuthentication UTCTime Maybe        -- last login date
+    created        UTCTime default=now()
+    lastLdapSynchronisation UTCTime Maybe
    tokensIssuedAfter  UTCTime Maybe        -- do not accept bearer tokens issued before this time (accept all tokens if null)
    matrikelnummer UserMatriculation Maybe  -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...)
    firstName      Text                     -- For export in tables, pre-split firstName from displayName
@ -30,14 +32,20 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
    UniqueAuthentication ident                  -- Column 'ident' can be used as a row-key in this table
    UniqueEmail email                           -- Column 'email' can be used as a row-key in this table
    deriving Show Eq Ord Generic                -- Haskell-specific settings for runtime-value representing a row in memory
-UserAdmin      -- Each row in this table grants school-specific administrator-rights to a specific user
-    user   UserId
-    school SchoolId
-    UniqueUserAdmin user school       -- combination of user+school must be unique, i.e. no duplicate rows
-UserLecturer   -- Each row in this table grants school-specific lecturer-rights to a specific user
-    user   UserId
-    school SchoolId
-    UniqueSchoolLecturer user school  -- combination of user+school must be unique, i.e. no duplicate rows
+UserFunction -- Administratively assigned functions (lecturer, admin, evaluation, ...)
+    user     UserId
+    school   SchoolId
+    function SchoolFunction
+    UniqueUserFunction user school function
+UserExamOffice
+    user     UserId
+    field    StudyTermsId
+    UniqueUserExamOffice user field
+UserSchool -- Managed by users themselves, encodes "schools of interest"
+    user     UserId
+    school   SchoolId
+    isOptOut Bool     -- true if this a marker, that the user manually deleted this entry; it should not be recreated automatically 
+    UniqueUserSchool user school
 StudyFeatures  -- multiple entries possible for students pursuing several degrees at once, usually created upon LDAP login
    user          UserId
    degree        StudyDegreeId   -- Abschluss, i.e. Master, Bachelor, etc.
--- a/10
+++ b/10
@ -49,8 +49,8 @@
 /users/#CryptoUUIDUser/hijack AdminHijackUserR     POST       !adminANDno-escalation
 /users/#CryptoUUIDUser/notifications UserNotificationR GET POST   !self
 /users/#CryptoUUIDUser/password      UserPasswordR     GET POST   !selfANDis-pw-hash
-!/users/lecturer-invite/new    AdminNewLecturerInviteR  GET POST
-!/users/lecturer-invite        AdminLecturerInviteR     GET POST
+!/users/functionary-invite/new AdminNewFunctionaryInviteR  GET POST
+!/users/functionary-invite     AdminFunctionaryInviteR     GET POST
 /admin                        AdminR           GET
 /admin/features               AdminFeaturesR   GET POST
 /admin/test                   AdminTestR       GET POST
@ -78,8 +78,10 @@
 !/term/#TermId             TermCourseListR     GET             !free
 !/term/#TermId/#SchoolId   TermSchoolCourseListR  GET          !free

-/school                    SchoolListR         GET             !development
-/school/#SchoolId          SchoolShowR         GET             !development
+/school                    SchoolListR         GET
+!/school/new               SchoolNewR          GET POST
+/school/#SchoolId          SchoolR:
+  /                        SchoolEditR         GET POST

 /allocation/               AllocationListR     GET             !free
 /allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
--- a/src/Auth/LDAP.hs
+++ b/src/Auth/LDAP.hs
@ -2,14 +2,15 @@ module Auth.LDAP
  ( apLdap
  , campusLogin
  , CampusUserException(..)
-  , campusUser
+  , campusUser, campusUser'
  , CampusMessage(..)
  , ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName
  , ldapUserMatriculation, ldapUserFirstName, ldapUserSurname
  , ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName
+  , ldapUserSchoolAssociation
  ) where

-import Import.NoFoundation hiding (userEmail, userDisplayName)
+import Import.NoFoundation
 import Network.Connection

 import Data.CaseInsensitive (CI)
@ -58,16 +59,17 @@ findUser LdapConf{..} ldap ident retAttrs = fromMaybe [] <$> findM (assertM (not
      , Ldap.derefAliases Ldap.DerefAlways
      ]

-ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName :: Ldap.Attr
-ldapUserPrincipalName = Ldap.Attr "userPrincipalName"
-ldapUserEmail         = Ldap.Attr "mail"
-ldapUserDisplayName   = Ldap.Attr "displayName"
-ldapUserMatriculation = Ldap.Attr "LMU-Stud-Matrikelnummer"
-ldapUserFirstName     = Ldap.Attr "givenName"
-ldapUserSurname       = Ldap.Attr "sn"
-ldapUserTitle         = Ldap.Attr "title"
-ldapUserStudyFeatures = Ldap.Attr "dfnEduPersonFeaturesOfStudy"
-ldapUserFieldName     = Ldap.Attr "dfnEduPersonFieldOfStudyString" 
+ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName, ldapUserMatriculation, ldapUserFirstName, ldapUserSurname, ldapUserTitle, ldapUserStudyFeatures, ldapUserFieldName, ldapUserSchoolAssociation :: Ldap.Attr
+ldapUserPrincipalName     = Ldap.Attr "userPrincipalName"
+ldapUserEmail             = Ldap.Attr "mail"
+ldapUserDisplayName       = Ldap.Attr "displayName"
+ldapUserMatriculation     = Ldap.Attr "LMU-Stud-Matrikelnummer"
+ldapUserFirstName         = Ldap.Attr "givenName"
+ldapUserSurname           = Ldap.Attr "sn"
+ldapUserTitle             = Ldap.Attr "title"
+ldapUserStudyFeatures     = Ldap.Attr "dfnEduPersonFeaturesOfStudy"
+ldapUserFieldName         = Ldap.Attr "dfnEduPersonFieldOfStudyString" 
+ldapUserSchoolAssociation = Ldap.Attr "LMU-IFI-eduPersonOrgUnitDNString" 


 data CampusUserException = CampusUserLdapError LdapPoolError
@ -80,6 +82,8 @@ data CampusUserException = CampusUserLdapError LdapPoolError

 instance Exception CampusUserException

+makePrisms ''CampusUserException
+
 campusUser :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) => LdapConf -> LdapPool -> Creds site -> m (Ldap.AttrList [])
 campusUser conf@LdapConf{..} pool Creds{..} = liftIO . (`catches` errHandlers) $ either (throwM . CampusUserLdapError) return <=< withLdap pool $ \ldap -> do
  Ldap.bind ldap ldapDn ldapPassword
@ -105,6 +109,10 @@ campusUser conf@LdapConf{..} pool Creds{..} = liftIO . (`catches` errHandlers) $
                  , Exc.Handler $ \(HostCannotConnect host excs) -> throwM $ CampusUserHostCannotConnect host excs
                  ]

+campusUser' :: (MonadBaseControl IO m, MonadCatch m, MonadIO m) => LdapConf -> LdapPool -> User -> m (Maybe (Ldap.AttrList []))
+campusUser' conf pool User{userIdent}
+  = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUser conf pool (Creds apLdap (CI.original userIdent) [])
+

 campusForm :: ( RenderMessage site FormMessage
              , RenderMessage site CampusMessage
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@ -64,6 +64,8 @@ false = E.val False
 isJust :: (E.Esqueleto query expr backend, PersistField typ) => expr (E.Value (Maybe typ)) -> expr (E.Value Bool)
 isJust = E.not_ . E.isNothing

+infix 4 `isInfixOf`, `hasInfix`
+
 -- | Check if the first string is contained in the text derived from the second argument
 isInfixOf :: ( E.Esqueleto query expr backend
             , E.SqlString s1
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -65,6 +65,7 @@ import Control.Monad.Memo.Class (MonadMemo(..), for4)
 import qualified Control.Monad.Catch as C

 import Handler.Utils.StudyFeatures
+import Handler.Utils.SchoolLdap
 import Utils.Form
 import Utils.Sheet
 import Utils.SystemMessage
@ -152,6 +153,7 @@ deriving instance Generic TutorialR
 deriving instance Generic ExamR
 deriving instance Generic CourseApplicationR
 deriving instance Generic AllocationR
+deriving instance Generic SchoolR
 deriving instance Generic (Route UniWorX)

 -- | Convenient Type Synonyms:
@ -310,6 +312,7 @@ embedRenderMessage ''UniWorX ''SubmissionModeDescr
 embedRenderMessage ''UniWorX ''UploadModeDescr id
 embedRenderMessage ''UniWorX ''SecretJSONFieldException id
 embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel
+embedRenderMessage ''UniWorX ''SchoolFunction id

 embedRenderMessage ''UniWorX ''AuthenticationMode id

@ -606,8 +609,9 @@ tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of
  CourseR tid ssh csh _ -> $cachedHereBinary (mAuthId, tid, ssh, csh) . exceptT return return $ do
    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
    isAdmin <- lift . E.selectExists . E.from $ \(course `E.InnerJoin` userAdmin) -> do
-      E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserAdminSchool
-      E.where_  $ userAdmin E.^. UserAdminUser E.==. E.val authId
+      E.on $ course E.^. CourseSchool E.==. userAdmin E.^. UserFunctionSchool
+      E.where_  $ userAdmin E.^. UserFunctionUser E.==. E.val authId
+            E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
            E.&&. course E.^. CourseTerm      E.==. E.val tid
            E.&&. course E.^. CourseSchool    E.==. E.val ssh
            E.&&. course E.^. CourseShorthand E.==. E.val csh
@ -617,17 +621,24 @@ tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of
  AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
    isAdmin <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` userAdmin) -> do
-      E.on $ allocation E.^. AllocationSchool E.==. userAdmin E.^. UserAdminSchool
-      E.where_  $ userAdmin E.^. UserAdminUser E.==. E.val authId
+      E.on $ allocation E.^. AllocationSchool E.==. userAdmin E.^. UserFunctionSchool
+      E.where_  $ userAdmin E.^. UserFunctionUser E.==. E.val authId
+            E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
            E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
            E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
            E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
    guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
    return Authorized
+  -- Schools: access only to school admins
+  SchoolR ssh _ -> $cachedHereBinary (mAuthId, ssh) . exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    isAdmin <- lift $ exists [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin]
+    guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
+    return Authorized
  -- other routes: access to any admin is granted here
  _other -> $cachedHereBinary mAuthId . exceptT return return $ do
    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-    adrights <- lift $ selectFirst [UserAdminUser ==. authId] []
+    adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolAdmin] []
    guardMExceptT (isJust adrights) (unauthorizedI MsgUnauthorizedSiteAdmin)
    return Authorized
 tagAccessPredicate AuthToken = APDB $ \mAuthId route isWrite -> exceptT return return $
@ -636,10 +647,9 @@ tagAccessPredicate AuthNoEscalation = APDB $ \mAuthId route _ -> case route of
  AdminHijackUserR cID -> exceptT return return $ do
    myUid <- maybeExceptT AuthenticationRequired $ return mAuthId
    uid <- decrypt cID
-    otherSchoolsAdmin <- lift $ Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. uid] []
-    otherSchoolsLecturer <- lift $ Set.fromList . map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] []
-    mySchools <- lift $ Set.fromList . map (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. myUid] []
-    guardMExceptT ((otherSchoolsAdmin `Set.union` otherSchoolsLecturer) `Set.isSubsetOf` mySchools) (unauthorizedI MsgUnauthorizedAdminEscalation)
+    otherSchoolsFunctions <- lift $ Set.fromList . map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid] []
+    mySchools <- lift $ Set.fromList . map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. myUid, UserFunctionFunction ==. SchoolAdmin] []
+    guardMExceptT (otherSchoolsFunctions `Set.isSubsetOf` mySchools) (unauthorizedI MsgUnauthorizedAdminEscalation)
    return Authorized
  r -> $unsupportedAuthPredicate AuthNoEscalation r
 tagAccessPredicate AuthDeprecated = APHandler $ \_ r _ -> do
@ -680,7 +690,7 @@ tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
  -- lecturer for any school will do
  _ -> $cachedHereBinary mAuthId . exceptT return return $ do
     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-     void . maybeMExceptT (unauthorizedI MsgUnauthorizedSchoolLecturer) $ selectFirst [UserLecturerUser ==. authId] []
+     void . maybeMExceptT (unauthorizedI MsgUnauthorizedSchoolLecturer) $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolLecturer] []
     return Authorized
 tagAccessPredicate AuthCorrector = APDB $ \mAuthId route _ -> exceptT return return $ do
  authId <- maybeExceptT AuthenticationRequired $ return mAuthId
@ -1736,6 +1746,10 @@ instance YesodBreadcrumbs UniWorX where
  breadcrumb AdminFeaturesR   = return ("Test"         , Just AdminR)
  breadcrumb AdminTestR       = return ("Test"         , Just AdminR)
  breadcrumb AdminErrMsgR     = return ("Test"         , Just AdminR)
+  
+  breadcrumb SchoolListR      = return ("Institute"    , Just AdminR)
+  breadcrumb (SchoolR ssh SchoolEditR) = return (original (unSchoolKey ssh), Just SchoolListR)
+  breadcrumb SchoolNewR       = return ("Neu"          , Just SchoolListR)

  breadcrumb InfoR            = return ("Information"  , Nothing)
  breadcrumb InfoLecturerR    = return ("Veranstalter" , Just InfoR)
@ -2009,6 +2023,14 @@ pageActions (HomeR) =
  ]
 pageActions (AdminR) =
  [ MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuSchoolList
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute SchoolListR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
      { menuItemType  = PageActionPrime
      , menuItemLabel = MsgAdminFeaturesHeading
      , menuItemIcon  = Nothing
@ -2041,12 +2063,22 @@ pageActions (AdminR) =
      , menuItemAccessCallback' = return True
      }
  ]
+pageActions (SchoolListR) =
+  [ MenuItem
+      { menuItemType  = PageActionPrime
+      , menuItemLabel = MsgMenuSchoolNew
+      , menuItemIcon  = Nothing
+      , menuItemRoute = SomeRoute SchoolNewR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
+  ]
 pageActions (UsersR) =
  [ MenuItem
      { menuItemType  = PageActionPrime
      , menuItemLabel = MsgMenuLecturerInvite
      , menuItemIcon  = Nothing
-      , menuItemRoute = SomeRoute AdminNewLecturerInviteR
+      , menuItemRoute = SomeRoute AdminNewFunctionaryInviteR
      , menuItemModal = True
      , menuItemAccessCallback' = return True
      }
@ -2874,13 +2906,6 @@ pageHeading (TermSchoolCourseListR tid ssh)
      School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh
      i18nHeading $ MsgTermSchoolCourseListHeading tid school

-pageHeading (SchoolListR)
-  = Just $ i18nHeading MsgSchoolListHeading
-pageHeading (SchoolShowR ssh)
-  = Just $ do
-      School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh
-      i18nHeading $ MsgSchoolHeading school
-
 pageHeading (CourseListR)
  = Just $ i18nHeading $ MsgCourseListTitle
 pageHeading CourseNewR
@ -3019,7 +3044,8 @@ data CampusUserConversionException
  | CampusUserInvalidSurname
  | CampusUserInvalidTitle
  | CampusUserInvalidMatriculation
-  | CampusUserInvalidFeaturesOfStudy String
+  | CampusUserInvalidFeaturesOfStudy Text
+  | CampusUserInvalidAssociatedSchools Text
  deriving (Eq, Ord, Read, Show, Generic, Typeable)
 instance Exception CampusUserConversionException

@ -3097,12 +3123,15 @@ upsertCampusUser ldapData Creds{..} = do
      , userNotificationSettings = def
      , userMailLanguages        = def
      , userTokensIssuedAfter    = Nothing
+      , userCreated              = now
+      , userLastLdapSynchronisation = Just now
      , ..
      }
-    userUpdate =  [ UserMatrikelnummer     =. userMatrikelnummer
-                  , UserDisplayName        =. userDisplayName
-                  , UserSurname            =. userSurname
-                  , UserEmail              =. userEmail
+    userUpdate =  [ UserMatrikelnummer          =. userMatrikelnummer
+                  , UserDisplayName             =. userDisplayName
+                  , UserSurname                 =. userSurname
+                  , UserEmail                   =. userEmail
+                  , UserLastLdapSynchronisation =. Just now
                  ] ++
                  [ UserLastAuthentication =. Just now | not isDummy ]

@ -3124,7 +3153,7 @@ upsertCampusUser ldapData Creds{..} = do
      Right str <- return $ Text.decodeUtf8' v'
      return str

-  fs <- either (throwM . CampusUserInvalidFeaturesOfStudy . unpack) return userStudyFeatures
+  fs <- either (throwM . CampusUserInvalidFeaturesOfStudy . tshow) return userStudyFeatures

  let
    studyTermCandidates = Set.fromList $ do
@ -3154,13 +3183,56 @@ upsertCampusUser ldapData Creds{..} = do
    insertMaybe studyFeaturesDegree $ StudyDegree (unStudyDegreeKey studyFeaturesDegree) Nothing Nothing
    insertMaybe studyFeaturesField $ StudyTerms (unStudyTermsKey studyFeaturesField) Nothing Nothing
    void $ upsert f [StudyFeaturesUpdated =. now, StudyFeaturesValid =. True]
+  associateUserSchoolsByTerms userId

+  let
+    userAssociatedSchools = fmap concat $ forM userAssociatedSchools' parseLdapSchools
+    userAssociatedSchools' = do
+      (k, v) <- ldapData
+      guard $ k == ldapUserSchoolAssociation
+      v' <- v
+      Right str <- return $ Text.decodeUtf8' v'
+      return str
+  
+  ss <- either (throwM . CampusUserInvalidAssociatedSchools . tshow) return userAssociatedSchools
+
+  forM_ ss $ \frag -> void . runMaybeT $ do
+    let
+      exactMatch = MaybeT . getBy $ UniqueOrgUnit frag
+      infixMatch = (hoistMaybe . preview _head =<<) . lift . E.select . E.from $ \schoolLdap -> do
+        E.where_ $ E.val frag `E.isInfixOf` schoolLdap E.^. SchoolLdapOrgUnit
+             E.&&. E.not_ (E.isNothing $ schoolLdap E.^. SchoolLdapSchool)
+        return schoolLdap
+    Entity _ SchoolLdap{..} <- exactMatch <|> infixMatch
+    ssh <- hoistMaybe schoolLdapSchool
+
+    lift . void $ insertUnique UserSchool
+      { userSchoolUser     = userId
+      , userSchoolSchool   = ssh
+      , userSchoolIsOptOut = False
+      }
+
+  forM_ ss $ void . insertUnique . SchoolLdap Nothing
+  
  return user
  where
    insertMaybe key val = get key >>= maybe (insert_ val) (\_ -> return ())
    isDummy  = credsPlugin == "dummy"
    isPWHash = credsPlugin == "PWHash"

+associateUserSchoolsByTerms :: UserId -> DB ()
+associateUserSchoolsByTerms uid = do
+  sfs <- selectList [StudyFeaturesUser ==. uid] []
+
+  forM_ sfs $ \(Entity _ StudyFeatures{..}) -> do
+    schoolTerms <- selectList [SchoolTermsTerms ==. studyFeaturesField] []
+    forM_ schoolTerms $ \(Entity _ SchoolTerms{..}) ->
+      void $ insertUnique UserSchool
+        { userSchoolUser     = uid
+        , userSchoolSchool   = schoolTermsSchool
+        , userSchoolIsOptOut = False
+        }
+

 instance YesodAuth UniWorX where
    type AuthId UniWorX = UserId
@ -3222,6 +3294,11 @@ instance YesodAuth UniWorX where

        acceptExisting = do
          res <- maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth
+          case res of
+            Authenticated uid
+              -> associateUserSchoolsByTerms uid
+            _other
+              -> return ()
          case res of
            Authenticated uid
              | not isDummy -> res <$ update uid [ UserLastAuthentication =. Just now ]
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@ -289,6 +289,7 @@ instance Button UniWorX ButtonAdminStudyTerms where
 getAdminFeaturesR, postAdminFeaturesR :: Handler Html
 getAdminFeaturesR = postAdminFeaturesR
 postAdminFeaturesR = do
+    uid <- requireAuthId
    ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonAdminStudyTerms)
    let btnForm = wrapForm btnWdgt def
          { formAction = Just $ SomeRoute AdminFeaturesR
@ -322,11 +323,21 @@ postAdminFeaturesR = do
    newStudyTermKeys <- fromMaybe [] <$> lookupSessionJson SessionNewStudyTerms
    (   (degreeResult,degreeTable)
      , (studyTermsResult,studytermsTable)
-      , ((), candidateTable)) <- runDB $ (,,)
-      <$> mkDegreeTable
-      <*> mkStudytermsTable (Set.fromList newStudyTermKeys)
-                            (Set.fromList $ map entityKey infConflicts)
-      <*> mkCandidateTable
+      , ((), candidateTable)
+      , userSchools) <- runDB $ do
+      schools <- E.select . E.from $ \school -> do
+        E.where_ . E.exists . E.from $ \schoolFunction ->
+          E.where_ $ schoolFunction E.^. UserFunctionSchool   E.==. school E.^. SchoolId
+               E.&&. schoolFunction E.^. UserFunctionUser     E.==. E.val uid
+               E.&&. schoolFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
+        return school
+      (,,,)
+        <$> mkDegreeTable
+        <*> mkStudytermsTable (Set.fromList newStudyTermKeys)
+                              (Set.fromList $ map entityKey infConflicts)
+                              (Set.fromList schools)
+        <*> mkCandidateTable
+        <*> pure schools

    -- This needs to happen after calls to `dbTable` so they can short-circuit correctly
    unless (null infConflicts) $ addMessageI Warning MsgStudyFeatureConflict
@ -341,12 +352,16 @@ postAdminFeaturesR = do
      void . runDB $ Map.traverseWithKey updateDegree res
      addMessageI Success MsgStudyDegreeChangeSuccess

-    let studyTermsResult' :: FormResult (Map (Key StudyTerms) (Maybe Text, Maybe Text))
+    let studyTermsResult' :: FormResult (Map (Key StudyTerms) (Maybe Text, Maybe Text, Set SchoolId))
        studyTermsResult' = studyTermsResult <&> getDBFormResult
-          (\row -> ( row ^. _dbrOutput . _entityVal . _studyTermsName
-                   , row ^. _dbrOutput . _entityVal . _studyTermsShorthand
+          (\row -> ( row ^. _dbrOutput . _1 . _entityVal . _studyTermsName
+                   , row ^. _dbrOutput . _1 . _entityVal . _studyTermsShorthand
+                   , row ^. _dbrOutput . _2
          ))
-        updateStudyTerms studyTermsKey (name,short) = update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short]
+        updateStudyTerms studyTermsKey (name,short,schools) = do
+          update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short]
+          forM_ schools $ \ssh -> void . insertUnique $ SchoolTerms ssh studyTermsKey
+          deleteWhere [SchoolTermsTerms ==. studyTermsKey, SchoolTermsSchool /<-. Set.toList schools, SchoolTermsSchool <-. toListOf (folded . _entityKey) userSchools]
    formResult studyTermsResult' $ \res -> do
      void . runDB $ Map.traverseWithKey updateStudyTerms res
      addMessageI Success MsgStudyTermsChangeSuccess
@ -355,24 +370,41 @@ postAdminFeaturesR = do
      setTitleI MsgAdminFeaturesHeading
      $(widgetFile "adminFeatures")
  where
-    textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
+    textInputCell :: Ord i
+                  => Lens' a (Maybe Text)
+                  -> Getter (DBRow r) (Maybe Text)
+                  -> Getter (DBRow r) i
+                  -> DBRow r 
+                  -> DBCell (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult i a (DBRow r)))
+    textInputCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
      (\row _mkUnique -> (\(res,fieldView) -> (set lensRes . assertM (not . Text.null) <$> res, fvInput fieldView))
        <$> mopt textField "" (Just $ row ^. lensDefault)
      )
+  
+    checkboxCell :: Ord i
+                 => Lens' a Bool
+                 -> Getter (DBRow r) Bool
+                 -> Getter (DBRow r) i
+                 -> DBRow r 
+                 -> DBCell (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult i a (DBRow r)))
+    checkboxCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
+      ( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvInput fieldView))
+        <$> mpopt checkBoxField "" (Just $ row ^. lensDefault)
+      )


    mkDegreeTable :: DB (FormResult (DBFormResult (Key StudyDegree) (Maybe Text, Maybe Text) (DBRow (Entity StudyDegree))), Widget)
    mkDegreeTable =
      let dbtIdent      = "admin-studydegrees" :: Text
          dbtStyle      = def
-          dbtSQLQuery   :: E.SqlExpr (Entity StudyDegree) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree))
+          dbtSQLQuery   :: E.SqlExpr (Entity StudyDegree) -> E.SqlQuery (E.SqlExpr (Entity StudyDegree))
          dbtSQLQuery   = return
          dbtRowKey     = (E.^. StudyDegreeKey)
          dbtProj       = return
          dbtColonnade  = formColonnade $ mconcat
            [ sortable (Just "key")   (i18nCell MsgGenericKey)  (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
-            , sortable (Just "name")  (i18nCell MsgDegreeName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
-            , sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
+            , sortable (Just "name")  (i18nCell MsgDegreeName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName) (_dbrOutput . _entityKey))
+            , sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand) (_dbrOutput . _entityKey))
            , dbRow
            ]
          dbtSorting    = Map.fromList
@ -390,20 +422,29 @@ postAdminFeaturesR = do
          dbtCsvDecode  = Nothing
      in dbTable psValidator DBTable{..}

-    mkStudytermsTable :: Set (Key StudyTerms) -> Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
-    mkStudytermsTable newKeys badKeys =
+    mkStudytermsTable :: Set (Key StudyTerms) -> Set (Key StudyTerms) -> Set (Entity School) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text, Set SchoolId) (DBRow (Entity StudyTerms, Set SchoolId))), Widget)
+    mkStudytermsTable newKeys badKeys schools =
      let dbtIdent      = "admin-studyterms" :: Text
          dbtStyle      = def
-          dbtSQLQuery   :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
+          dbtSQLQuery   :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery (E.SqlExpr (Entity StudyTerms))
          dbtSQLQuery   = return
          dbtRowKey     = (E.^. StudyTermsKey)
-          dbtProj       = return
+          dbtProj field = do
+            fieldSchools <- fmap (setOf $ folded . _Value) . lift . E.select . E.from $ \school -> do
+              E.where_ . E.exists . E.from $ \schoolTerms ->
+                E.where_ $ schoolTerms E.^. SchoolTermsSchool E.==. school E.^. SchoolId
+                     E.&&. schoolTerms E.^. SchoolTermsTerms  E.==. E.val (field ^. _dbrOutput . _entityKey)
+              E.where_ $ school E.^. SchoolShorthand `E.in_` E.valList (toListOf (folded . _entityKey . _SchoolId) schools)
+              return $ school E.^. SchoolId
+            return $ field & _dbrOutput %~ (, fieldSchools)
          dbtColonnade  = formColonnade $ mconcat
-            [ sortable (Just "key")   (i18nCell MsgGenericKey)         (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
-            , sortable (Just "isnew") (i18nCell MsgGenericIsNew)       (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
-            , sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _entityKey))
-            , sortable (Just "name")  (i18nCell MsgStudyTermsName)     (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
-            , sortable (Just "short") (i18nCell MsgStudyTermsShort)    (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
+            [ sortable (Just "key")   (i18nCell MsgGenericKey)         (numCell . view (_dbrOutput . _1 . _entityVal . _studyTermsKey))
+            , sortable (Just "isnew") (i18nCell MsgGenericIsNew)       (isNewCell . flip Set.member newKeys . view (_dbrOutput . _1 . _entityKey))
+            , sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _1 . _entityKey))
+            , sortable (Just "name")  (i18nCell MsgStudyTermsName)     (textInputCell _1 (_dbrOutput . _1 . _entityVal . _studyTermsName) (_dbrOutput . _1 . _entityKey))
+            , sortable (Just "short") (i18nCell MsgStudyTermsShort)    (textInputCell _2 (_dbrOutput . _1 . _entityVal . _studyTermsShorthand) (_dbrOutput . _1 . _entityKey))
+            , flip foldMap schools $ \(Entity ssh School{schoolName}) ->
+                sortable Nothing (cell $ toWidget schoolName) (checkboxCell (_3 . at ssh . _Maybe) (_dbrOutput . _2 . at ssh . _Maybe) (_dbrOutput . _1 . _entityKey))
            , dbRow
            ]
          dbtSorting    = Map.fromList
--- a/src/Handler/Course/Application/Edit.hs
+++ b/src/Handler/Course/Application/Edit.hs
@ -19,8 +19,8 @@ postCAEditR tid ssh csh cID = do
    mAlloc <- traverse getEntity404 $ courseApplicationAllocation app
    appUser <- get404 $ courseApplicationUser app
    isAdmin <- case mAlloc of
-      Just alloc -> exists [UserAdminUser ==. uid, UserAdminSchool ==. alloc ^. _entityVal . _allocationSchool]
-      Nothing    -> exists [UserAdminUser ==. uid, UserAdminSchool ==. course ^. _entityVal . _courseSchool]
+      Just alloc -> exists [UserFunctionUser ==. uid, UserFunctionSchool ==. alloc ^. _entityVal . _allocationSchool, UserFunctionFunction ==. SchoolAdmin]
+      Nothing    -> exists [UserFunctionUser ==. uid, UserFunctionSchool ==. course ^. _entityVal . _courseSchool, UserFunctionFunction ==. SchoolAdmin]
    return (mAlloc, course, app, isAdmin, appUser)

  afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
--- a/src/Handler/Course/Application/List.hs
+++ b/src/Handler/Course/Application/List.hs
@ -525,6 +525,7 @@ postCApplicationsR tid ssh csh = do

      psValidator :: PSValidator _ _
      psValidator = def
+        & defaultSorting [SortAscBy "user-name"]

    dbTableWidget' psValidator DBTable{..}

--- a/src/Handler/Course/Edit.hs
+++ b/src/Handler/Course/Edit.hs
@ -105,10 +105,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
    MsgRenderer mr <- getMsgRenderer

    uid <- liftHandlerT requireAuthId
-    (lecSchools, admSchools) <- liftHandlerT . runDB $ (,)
-      <$> (map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. uid] [] )
-      <*> (map (userAdminSchool    . entityVal) <$> selectList [UserAdminUser    ==. uid] [] )
-    let userSchools = lecSchools ++ admSchools
+    userSchools <- liftHandlerT . runDB $ map (userFunctionSchool . entityVal) <$> selectList [UserFunctionUser ==. uid, UserFunctionFunction <-. [SchoolAdmin, SchoolLecturer]] []

    termsField <- case template of
          -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
@ -278,11 +275,11 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do
      _ -> (result, widget)


-validateCourse :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseForm -> m [Text]
+validateCourse :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => CourseForm -> m [Text]
 validateCourse CourseForm{..} = do
  now <- liftIO getCurrentTime
  uid <- liftHandlerT requireAuthId
-  userAdmin <- liftHandlerT . runDB . getBy $ UniqueUserAdmin uid cfSchool -- FIXME: This /needs/ to be a call to `isAuthorized` on a route
+  userAdmin <- hasWriteAccessTo $ SchoolR cfSchool SchoolEditR
  MsgRenderer mr <- getMsgRenderer
  allocationTerm <- for (acfAllocation <$> cfAllocation) $ fmap allocationTerm . liftHandlerT . runDB . getJust

@ -291,7 +288,7 @@ validateCourse CourseForm{..} = do
    prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse

    fmap join . for prevAllocation $ \Allocation{allocationStaffRegisterTo} -> if
-      | is _Just userAdmin
+      | userAdmin
        -> return Nothing
      | NTop allocationStaffRegisterTo <= NTop (Just now)
        -> Just . courseCapacity <$> getJust cid
@ -309,7 +306,7 @@ validateCourse CourseForm{..} = do
          ( NTop cfRegFrom <= NTop cfDeRegUntil
          , MsgCourseDeregistrationEndMustBeAfterStart
          )
-        , ( maybe (anyOf (traverse . _Right . _1) (== uid) cfLecturers) (\(Entity _ UserAdmin{}) -> True) userAdmin
+        , ( bool (anyOf (traverse . _Right . _1) (== uid) cfLecturers) True userAdmin
          , MsgCourseUserMustBeLecturer
          )
        , ( is _Nothing cfAllocation || is _Just cfCapacity
@ -357,8 +354,9 @@ getCourseNewR = do
                      E.&&.  lecturer E.^. LecturerCourse E.==. course E.^. CourseId
          let lecturersSchool =
                E.exists $ E.from $ \user ->
-                  E.where_ $ user E.^. UserLecturerUser   E.==. E.val uid
-                      E.&&.  user E.^. UserLecturerSchool E.==. course E.^. CourseSchool
+                  E.where_ $ user E.^. UserFunctionUser     E.==. E.val uid
+                      E.&&.  user E.^. UserFunctionSchool   E.==. course E.^. CourseSchool
+                      E.&&.  user E.^. UserFunctionFunction E.==. E.val SchoolLecturer
          let courseCreated c =
                E.sub_select . E.from $ \edit -> do      -- oldest edit must be creation
                  E.where_ $ edit E.^. CourseEditCourse E.==. c E.^. CourseId
@ -527,17 +525,16 @@ courseEditHandler miButtonAction mbCourseForm = do
        , formEncoding = formEnctype
        }

-upsertAllocationCourse :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe AllocationCourseForm -> ReaderT SqlBackend m ()
+upsertAllocationCourse :: (MonadLogger m, MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe AllocationCourseForm -> ReaderT SqlBackend m ()
 upsertAllocationCourse cid cfAllocation = do
  now <- liftIO getCurrentTime
-  uid <- liftHandlerT requireAuthId
  Course{..} <- getJust cid
  prevAllocationCourse <- getBy $ UniqueAllocationCourse cid
  prevAllocation <- fmap join . traverse get $ allocationCourseAllocation . entityVal <$> prevAllocationCourse
-  userAdmin <- liftHandlerT . runDB . getBy $ UniqueUserAdmin uid courseSchool -- FIXME: This /needs/ to be a call to `isAuthorized` on a route
+  userAdmin <- hasWriteAccessTo $ SchoolR courseSchool SchoolEditR

  doEdit <- if
-    | is _Just userAdmin
+    | userAdmin
      -> return True
    | Just Allocation{allocationStaffRegisterTo} <- prevAllocation
    , NTop allocationStaffRegisterTo <= NTop (Just now)
--- a/src/Handler/Course/LecturerInvite.hs
+++ b/src/Handler/Course/LecturerInvite.hs
@ -61,7 +61,7 @@ lecturerInvitationConfig = InvitationConfig{..}
      getKeyBy404 $ TermSchoolCourseShort tid csh ssh
    invitationSubject (Entity _ Course{..}) _ = return . SomeMessage $ MsgMailSubjectLecturerInvitation courseTerm courseSchool courseShorthand
    invitationHeading (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
-    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
+    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
    invitationTokenConfig _ _ = do
      itAuthority <- liftHandlerT requireAuthId
      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
--- a/src/Handler/Course/ParticipantInvite.hs
+++ b/src/Handler/Course/ParticipantInvite.hs
@ -74,7 +74,7 @@ participantInvitationConfig = InvitationConfig{..}
      getKeyBy404 $ TermSchoolCourseShort tid csh ssh
    invitationSubject     (Entity _ Course{..}) _ = return . SomeMessage $ MsgMailSubjectParticipantInvitation courseTerm courseSchool courseShorthand
    invitationHeading     (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseParticipantInviteHeading $ CI.original courseName
-    invitationExplanation _          _ = [ihamlet|_{SomeMessage MsgCourseParticipantInviteExplanation}|]
+    invitationExplanation  _                    _ = return [ihamlet|_{SomeMessage MsgCourseParticipantInviteExplanation}|]
    invitationTokenConfig _ _ = do
      itAuthority <- liftHandlerT requireAuthId
      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
--- a/src/Handler/Exam/CorrectorInvite.hs
+++ b/src/Handler/Exam/CorrectorInvite.hs
@ -61,7 +61,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
      Course{..} <- get404 examCourse
      return . SomeMessage $ MsgMailSubjectExamCorrectorInvitation courseTerm courseSchool courseShorthand examName
    invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInviteHeading examName
-    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
+    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
    invitationTokenConfig _ _ = do
      itAuthority <- liftHandlerT requireAuthId
      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
--- a/src/Handler/Exam/RegistrationInvite.hs
+++ b/src/Handler/Exam/RegistrationInvite.hs
@ -69,7 +69,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
      Course{..} <- get404 examCourse
      return . SomeMessage $ MsgMailSubjectExamRegistrationInvitation courseTerm courseSchool courseShorthand examName
    invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamRegistrationInviteHeading examName
-    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgExamRegistrationInviteExplanation}|]
+    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamRegistrationInviteExplanation}|]
    invitationTokenConfig _ (InvDBDataExamRegistration{..}, _) = do
      itAuthority <- liftHandlerT requireAuthId
      let itExpiresAt = Just $ Just invDBExamRegistrationDeadline
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@ -15,6 +15,7 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 -- import           Database.Esqueleto      ((^.))

+import qualified Data.CaseInsensitive as CI


 data SettingsForm = SettingsForm
@ -25,15 +26,31 @@ data SettingsForm = SettingsForm
      , stgTime          :: DateTimeFormat
      , stgDownloadFiles :: Bool
      , stgWarningDays   :: NominalDiffTime
+      , stgSchools       :: Set SchoolId
      , stgNotificationSettings :: NotificationSettings
      }

-data NotificationTriggerKind = NTKAll | NTKCourseParticipant | NTKExamParticipant | NTKCorrector | NTKLecturer | NTKAdmin
-  deriving (Eq, Ord, Enum, Bounded, Generic, Typeable)
-instance Universe NotificationTriggerKind
-instance Finite NotificationTriggerKind
+data NotificationTriggerKind
+  = NTKAll
+  | NTKCourseParticipant
+  | NTKExamParticipant
+  | NTKCorrector
+  | NTKFunctionary SchoolFunction
+  deriving (Eq, Ord, Generic, Typeable)
+deriveFinite ''NotificationTriggerKind

-embedRenderMessage ''UniWorX ''NotificationTriggerKind $ ("NotificationTriggerKind" <>) . mconcat . drop 1 . splitCamel
+instance RenderMessage UniWorX NotificationTriggerKind where
+  renderMessage f ls = \case
+    NTKAll -> mr MsgNotificationTriggerKindAll
+    NTKCourseParticipant -> mr MsgNotificationTriggerKindCourseParticipant
+    NTKExamParticipant -> mr MsgNotificationTriggerKindExamParticipant
+    NTKCorrector -> mr MsgNotificationTriggerKindCorrector
+    NTKFunctionary SchoolAdmin -> mr MsgNotificationTriggerKindAdmin
+    NTKFunctionary SchoolLecturer -> mr MsgNotificationTriggerKindLecturer
+    NTKFunctionary SchoolExamOffice -> mr MsgNotificationTriggerKindExamOffice
+    NTKFunctionary SchoolEvaluation -> mr MsgNotificationTriggerKindEvaluation
+    where
+      mr = renderMessage f ls


 makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
@ -55,38 +72,36 @@ makeSettingForm template html = do
                & setTooltip MsgWarningDaysTip
              ) (stgWarningDays <$> template)
        <*  aformSection MsgFormNotifications
+        <*> schoolsForm (stgSchools <$> template)
        <*> notificationForm (stgNotificationSettings <$> template)
    return (result, widget) -- no validation required here
  where
    themeList = [Option (toMessage t) t (toPathPiece t) | t <- universeF]
--
-- Version with proper grouping:
--
-- makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
-- makeSettingForm template = identForm FIDsettings $ \html -> do
--     (result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2
--       <$> aFormGroup "Cosmetics"     cosmeticsForm
--       <*> aFormGroup "Notifications" notificationsForm
--       <*  submitButton
--     return (result, widget) -- no validation required here
--   where
--     settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm
--     settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm
--     themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
--     cosmeticsForm = (,,,,)
--       <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
--             (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
--       <*> areq (selectField . return $ mkOptionList themeList)
--             (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
--       <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
--       <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
--       <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
--     notificationsForm = (,)
--       <$> areq checkBoxField (fslI MsgDownloadFiles
--                                & setTooltip MsgDownloadFilesTip
--                              ) (stgDownloadFiles <$> template)
--       <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
--     nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
+
+schoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId)
+schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandard schoolsForm' mempty
+  where
+    schoolsForm' :: WForm Handler (FormResult (Set SchoolId))
+    schoolsForm' = do
+      allSchools <- liftHandlerT . runDB $ selectList [] [Asc SchoolName]
+
+      let
+        schoolForm (Entity ssh School{schoolName})
+          = fmap (bool Set.empty $ Set.singleton ssh) <$> wpopt checkBoxField (fsl $ CI.original schoolName) (Set.member ssh <$> template)
+
+      fold <$> mapM schoolForm allSchools
+
+    schoolsFormView :: (FormResult (Set SchoolId), Widget) -> MForm Handler (FormResult (Set SchoolId), [FieldView UniWorX])
+    schoolsFormView (res, fvInput) = do
+      mr <- getMessageRender
+      let fvLabel = toHtml $ mr MsgUserSchools
+          fvTooltip = Just . toHtml $ mr MsgUserSchoolsTip
+          fvRequired = False
+          fvErrors
+            | FormFailure (err : _) <- res = Just $ toHtml err
+            | otherwise = Nothing
+      fvId <- newIdent
+      return (res, pure FieldView{..})

 notificationForm :: Maybe NotificationSettings -> AForm Handler NotificationSettings
 notificationForm template = wFormToAForm $ do
@ -99,13 +114,10 @@ notificationForm template = wFormToAForm $ do
      | isAdmin
      = return False
      | Just uid <- mbUid
-      , NTKAdmin <- nt
-      = fmap not . E.selectExists . E.from $ \userAdmin ->
-          E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
-      | Just uid <- mbUid
-      , NTKLecturer <- nt
-      = fmap not . E.selectExists . E.from $ \userLecturer ->
-          E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
+      , NTKFunctionary f <- nt
+      = fmap not . E.selectExists . E.from $ \userFunction ->
+          E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
+               E.&&. userFunction E.^. UserFunctionFunction E.==. E.val f
      | Just uid <- mbUid
      , NTKCorrector <- nt
      = fmap not . E.selectExists . E.from $ \sheetCorrector ->
@ -141,9 +153,9 @@ notificationForm template = wFormToAForm $ do
      NTSubmissionRated           -> Just NTKCourseParticipant
      NTSheetActive               -> Just NTKCourseParticipant
      NTSheetSoonInactive         -> Just NTKCourseParticipant
-      NTSheetInactive             -> Just NTKLecturer
+      NTSheetInactive             -> Just $ NTKFunctionary SchoolLecturer
      NTCorrectionsAssigned       -> Just NTKCorrector
-      NTCorrectionsNotDistributed -> Just NTKLecturer
+      NTCorrectionsNotDistributed -> Just $ NTKFunctionary SchoolLecturer
      NTUserRightsUpdate          -> Just NTKAll
      NTUserAuthModeUpdate        -> Just NTKAll
      NTExamResult                -> Just NTKExamParticipant
@ -177,6 +189,12 @@ getProfileR, postProfileR :: Handler Html
 getProfileR = postProfileR
 postProfileR = do
  (uid, 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)
+           E.&&. userSchool E.^. UserSchoolUser E.==. E.val uid
+           E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
+    return $ school E.^. SchoolId
  let settingsTemplate = Just SettingsForm
        { stgMaxFavourties = userMaxFavourites
        , stgTheme         = userTheme
@ -184,6 +202,7 @@ postProfileR = do
        , stgDate          = userDateFormat
        , stgTime          = userTimeFormat
        , stgDownloadFiles = userDownloadFiles
+        , stgSchools       = userSchools
        , stgNotificationSettings = userNotificationSettings
        , stgWarningDays   = userWarningDays
        }
@ -207,6 +226,25 @@ postProfileR = do
                                  , OffsetBy stgMaxFavourties
                                  ]
        mapM_ delete oldFavs
+      let
+        symDiff = (stgSchools `Set.difference` userSchools) `Set.union` (userSchools `Set.difference` stgSchools)
+      forM_ symDiff $ \ssh -> if
+        | ssh `Set.member` stgSchools
+          -> void $ upsert UserSchool
+               { userSchoolSchool   = ssh
+               , userSchoolUser     = uid
+               , userSchoolIsOptOut = False
+               }
+               [ UserSchoolIsOptOut =. False
+               ]
+        | otherwise
+          -> void $ upsert UserSchool
+               { userSchoolSchool   = ssh
+               , userSchoolUser     = uid
+               , userSchoolIsOptOut = True
+               }
+               [ UserSchoolIsOptOut =. True
+               ]
    addMessageI Info MsgSettingsUpdate
    redirect $ ProfileR :#: ProfileSettings

@ -255,14 +293,7 @@ getProfileDataR = do
 makeProfileData :: Entity User -> DB Widget
 makeProfileData (Entity uid User{..}) = do
  -- MsgRenderer mr <- getMsgRenderer
-  admin_rights <- E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
-      E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
-      E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
-      return (school E.^. SchoolShorthand)
-  lecturer_rights <- E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
-      E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
-      E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
-      return (school E.^. SchoolShorthand)
+  functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. uid] []
  lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
      E.on $ sheet E.^. SheetCourse E.==. course    E.^. CourseId
      E.on $ sheet E.^. SheetId     E.==. corrector E.^. SheetCorrectorSheet
@ -314,7 +345,7 @@ mkOwnedCoursesTable =
              return $ indicatorCell -- return True if one cell is produced here
                `mappend` termCell tid
          , sortable (Just "school") (i18nCell MsgCourseSchool) $
-              schoolCell <$> view (_dbrOutput . _1 . re _Just)
+              schoolCell <$> view (_dbrOutput . _1)
                         <*> view (_dbrOutput . _2 )
          , sortable (Just "course") (i18nCell MsgCourse) $
              courseCellCL <$> view _dbrOutput
@ -362,8 +393,8 @@ mkEnrolledCoursesTable =
          , sortable (Just "term") (i18nCell MsgTerm) $
              termCell   <$> view (_dbrOutput . _1 . _entityVal . _courseTerm)
          , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $
-              schoolCell <$> view ( _courseTerm . re _Just)
-                          <*> view  _courseSchool
+              schoolCell <$> view _courseTerm
+                         <*> view _courseSchool
          , sortable (Just "course") (i18nCell MsgCourse) $
              courseCell <$> view (_dbrOutput . _1 . _entityVal)
          , sortable (Just "time") (i18nCell MsgRegistered) $ do
@ -430,7 +461,7 @@ mkSubmissionTable =
        , sortable (Just "term") (i18nCell MsgTerm) $
            termCell    <$> view (_dbrOutput . _1 . _1)
        , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
-            schoolCell  <$> view ( _1. re _Just)
+            schoolCell  <$> view  _1
                        <*> view  _2
        , sortable (Just "course") (i18nCell MsgCourse) $
            courseCellCL <$> view (_dbrOutput . _1)
@ -512,7 +543,7 @@ mkSubmissionGroupTable =
        , sortable (Just "term") (i18nCell MsgTerm) $
            termCell    <$> view (_dbrOutput . _1 . _1)
        , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
-            schoolCell  <$> view ( _1. re _Just)
+            schoolCell  <$> view _1
                        <*> view _2
        , sortable (Just "course") (i18nCell MsgCourse) $
            courseCellCL <$> view (_dbrOutput . _1)
--- a/src/Handler/School.hs
+++ b/src/Handler/School.hs
@ -1,10 +1,169 @@
 module Handler.School where

 import Import
+import Handler.Utils
+import Handler.Utils.Table.Columns
+
+import qualified Database.Esqueleto as E
+
+import qualified Data.Set as Set
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Text as Text
+  

 getSchoolListR :: Handler Html
-getSchoolListR = error "getSchoolListR: Not implemented"
+getSchoolListR = do
+  let
+    schoolLink :: SchoolId -> SomeRoute UniWorX
+    schoolLink ssh = SomeRoute $ SchoolR ssh SchoolEditR
+    
+    dbtSQLQuery :: E.SqlExpr (Entity School) -> E.SqlQuery _
+    dbtSQLQuery = return

-getSchoolShowR :: SchoolId -> Handler Html
-getSchoolShowR = error "getSchoolShowR: Not implemented"
+    dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) (DBRow (Entity School))
+    dbtProj = return

+    dbtRowKey = (E.^. SchoolId)
+
+    dbtColonnade :: Colonnade Sortable _ _
+    dbtColonnade = mconcat
+      [ colSchoolShort $ _dbrOutput . _entityKey
+      , anchorColonnade (views (_dbrOutput . _entityKey) schoolLink) $ colSchoolName (_dbrOutput . _entityVal . _schoolName)
+      ]
+
+    dbtSorting = mconcat
+      [ sortSchoolShort $ to (E.^. SchoolId)
+      , sortSchoolName $ to (E.^. SchoolName)
+      ]
+
+    dbtFilter = mempty
+    dbtFilterUI = mempty
+
+    dbtStyle = def
+    dbtParams = def
+
+    dbtCsvEncode = noCsvEncode
+    dbtCsvDecode = Nothing
+
+    dbtIdent :: Text
+    dbtIdent = "schools"
+
+    psValidator = def
+      & defaultSorting [SortAscBy "school-name"]
+    
+
+  table <- runDB $ dbTableWidget' psValidator DBTable{..}
+
+  let title = MsgMenuSchoolList
+  siteLayoutMsg title $ do
+    setTitleI title
+    table
+
+data SchoolForm = SchoolForm
+  { sfShorthand :: CI Text
+  , sfName :: CI Text
+  , sfOrgUnits :: Set (CI Text)
+  }
+
+mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
+mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
+  <$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh ciField (fslI MsgSchoolShort)
+  <*> areq ciField (fslI MsgSchoolName) (sfName <$> template)
+  <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip) <$> massInputListA (textField & addDatalist ldapOrgs) (const "") (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (fmap CI.original . Set.toList . sfOrgUnits <$> template))
+  where
+    ldapOrgs :: WidgetT UniWorX IO (Set (CI Text))
+    ldapOrgs = liftHandlerT . runDB $
+      setOf (folded . _entityVal . _schoolLdapOrgUnit) <$> selectList [] []
+
+schoolToForm :: SchoolId -> DB (Form SchoolForm)
+schoolToForm ssh = do
+  School{..} <- get404 ssh
+  ldapFrags <- selectList [SchoolLdapSchool ==. Just ssh] []
+  return . mkSchoolForm (Just ssh) $ Just SchoolForm
+    { sfShorthand = schoolShorthand
+    , sfName = schoolName
+    , sfOrgUnits = setOf (folded . _entityVal . _schoolLdapOrgUnit) ldapFrags
+    }
+
+
+getSchoolEditR, postSchoolEditR :: SchoolId -> Handler Html
+getSchoolEditR = postSchoolEditR
+postSchoolEditR ssh = do
+  sForm <- runDB $ schoolToForm ssh
+  
+  ((sfResult, sfView), sfEnctype) <- runFormPost sForm
+
+  formResult sfResult $ \SchoolForm{..} -> do
+    runDB $ do
+      update ssh [ SchoolName =. sfName ]
+      forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
+        void $ upsert SchoolLdap
+          { schoolLdapSchool = Just ssh
+          , ..
+          }
+          [ SchoolLdapSchool =. Just ssh
+          ]
+      deleteWhere [SchoolLdapSchool ==. Just ssh, SchoolLdapOrgUnit /<-. Set.toList sfOrgUnits]
+      addMessageI Success $ MsgSchoolUpdated ssh
+    redirect $ SchoolR ssh SchoolEditR
+
+  let sfView' = wrapForm sfView FormSettings
+        { formMethod = POST
+        , formAction = Just . SomeRoute $ SchoolR ssh SchoolEditR
+        , formEncoding = sfEnctype
+        , formAttrs = []
+        , formSubmit = FormSubmit
+        , formAnchor = Nothing :: Maybe Text
+        }
+
+  siteLayoutMsg (MsgSchoolTitle ssh) $ do
+    setTitleI $ MsgSchoolTitle ssh
+    sfView'
+
+getSchoolNewR, postSchoolNewR :: Handler Html
+getSchoolNewR = postSchoolNewR
+postSchoolNewR = do
+  uid <- requireAuthId
+  ((sfResult, sfView), sfEnctype) <- runFormPost $ mkSchoolForm Nothing Nothing
+
+  formResult sfResult $ \SchoolForm{..} -> do
+    let ssh = SchoolKey sfShorthand
+    insertOkay <- runDB $ do
+      didInsert <- is _Just <$> insertUnique School
+        { schoolShorthand = sfShorthand
+        , schoolName = sfName
+        }
+      when didInsert $ do
+        insert_ UserFunction
+          { userFunctionUser     = uid
+          , userFunctionSchool   = ssh
+          , userFunctionFunction = SchoolAdmin
+          }
+        forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
+          void $ upsert SchoolLdap
+            { schoolLdapSchool = Just ssh
+            , ..
+            }
+            [ SchoolLdapSchool =. Just ssh
+            ]
+      return didInsert
+
+    if
+      | insertOkay -> do
+          addMessageI Success $ MsgSchoolCreated ssh
+          redirect $ SchoolR ssh SchoolEditR
+      | otherwise
+        -> addMessageI Error $ MsgSchoolExists ssh
+
+  let sfView' = wrapForm sfView FormSettings
+        { formMethod = POST
+        , formAction = Just $ SomeRoute SchoolNewR
+        , formEncoding = sfEnctype
+        , formAttrs = []
+        , formSubmit = FormSubmit
+        , formAnchor = Nothing :: Maybe Text
+        }
+
+  siteLayoutMsg MsgTitleSchoolNew $ do
+    setTitleI MsgTitleSchoolNew
+    sfView'
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@ -902,7 +902,7 @@ correctorInvitationConfig = InvitationConfig{..}
      Course{..} <- get404 sheetCourse
      return . SomeMessage $ MsgMailSubjectCorrectorInvitation courseTerm courseSchool courseShorthand sheetName
    invitationHeading (Entity _ Sheet{..}) _ = return . SomeMessage $ MsgSheetCorrInviteHeading sheetName
-    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSheetCorrInviteExplanation}|]
+    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgSheetCorrInviteExplanation}|]
    invitationTokenConfig _ _ = do
      itAuthority <- liftHandlerT requireAuthId
      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@ -100,7 +100,7 @@ submissionUserInvitationConfig = InvitationConfig{..}
    invitationHeading (Entity _ Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      return . SomeMessage $ MsgSubmissionUserInviteHeading sheetName
-    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSubmissionUserInviteExplanation}|]
+    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgSubmissionUserInviteExplanation}|]
    invitationTokenConfig (Entity _ Submission{..}) _ = do
      Sheet{..} <- getJust submissionSheet
      Course{..} <- getJust sheetCourse
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@ -257,7 +257,14 @@ newTermForm template html = do
        = aforced termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) tid
        | otherwise
        = areq termNewField (fslpI MsgTerm (mr MsgTermPlaceholder)) Nothing
-      holidayForm = formToAForm . over (mapped._2) pure $ massInputList dayField (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder)) (const Nothing) ("holidays" :: Text) (fslI MsgTermHolidays & setTooltip MsgMassInputTip) True (tftHolidays template) mempty
+      holidayForm = massInputListA
+        dayField
+        (const $ "" & addPlaceholder (mr MsgTermHolidayPlaceholder))
+        (const Nothing)
+        ("holidays" :: Text)
+        (fslI MsgTermHolidays & setTooltip MsgMassInputTip)
+        True
+        (tftHolidays template)
    (result, widget) <- flip (renderAForm FormStandard) html $ Term
      <$> tidForm
      <*> areq dayField  (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template)
--- a/src/Handler/Tutorial.hs
+++ b/src/Handler/Tutorial.hs
@ -258,7 +258,7 @@ tutorInvitationConfig = InvitationConfig{..}
      Course{..} <- get404 tutorialCourse
      return . SomeMessage $ MsgMailSubjectTutorInvitation courseTerm courseSchool courseShorthand tutorialName
    invitationHeading (Entity _ Tutorial{..}) _ = return . SomeMessage $ MsgTutorInviteHeading tutorialName
-    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgTutorInviteExplanation}|]
+    invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgTutorInviteExplanation}|]
    invitationTokenConfig _ _ = do
      itAuthority <- liftHandlerT requireAuthId
      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@ -58,30 +58,20 @@ getUsersR = do
 --           (AdminUserR <$> encrypt uid)
 --           (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)
      , sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication
-      , sortable Nothing (i18nCell MsgAdminFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
-          schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userAdmin) -> do
-            E.on $ school E.^. SchoolId E.==. userAdmin E.^. UserAdminSchool
-            E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
-            E.orderBy [E.asc $ school E.^. SchoolShorthand]
-            return $ school E.^. SchoolShorthand
-          return [whamlet|
-            $newline never
-            <ul .list--inline .list--comma-separated>
-              $forall (E.Value sh) <- schools
-                <li>#{sh}
-            |]
-      , sortable Nothing (i18nCell MsgLecturerFor) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
-          schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userLecturer) -> do
-            E.on $ school E.^. SchoolId E.==. userLecturer E.^. UserLecturerSchool
-            E.where_ $ userLecturer E.^. UserLecturerUser E.==. E.val uid
-            E.orderBy [E.asc $ school E.^. SchoolShorthand]
-            return $ school E.^. SchoolShorthand
-          return [whamlet|
-            $newline never
-            <ul .list--inline .list--comma-separated>
-              $forall (E.Value sh) <- schools
-                <li>#{sh}
-            |]
+      , flip foldMap universeF $ \function ->
+          sortable Nothing (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
+            schools <- lift . E.select . E.from $ \(school `E.InnerJoin` userFunction) -> do
+              E.on $ school E.^. SchoolId E.==. userFunction E.^. UserFunctionSchool
+              E.where_ $ userFunction E.^. UserFunctionUser E.==. E.val uid
+                   E.&&. userFunction E.^. UserFunctionFunction E.==. E.val function
+              E.orderBy [E.asc $ school E.^. SchoolShorthand]
+              return $ school E.^. SchoolShorthand
+            return [whamlet|
+              $newline never
+              <ul .list--inline .list--comma-separated>
+                $forall (E.Value sh) <- schools
+                  <li>#{sh}
+              |]
      , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity uid _ } -> cell $ do
          cID <- encrypt uid
          mayHijack <- (== Authorized) <$> evalAccess (AdminHijackUserR cID) True
@ -142,14 +132,8 @@ getUsersR = do
          , ( "school", FilterColumn $ \user criterion -> if
                | Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool)
                | otherwise          -> let schools = E.valList (Set.toList criterion) in
-                      E.exists ( E.from $ \ulectr -> do
-                        E.where_ $ ulectr E.^. UserLecturerUser    E.==. user E.^. UserId
-                        E.where_ $ ulectr E.^. UserLecturerSchool `E.in_` schools
-                    ) E.||.
-                      E.exists ( E.from $ \uadmin -> do
-                        E.where_ $ uadmin E.^. UserAdminUser       E.==. user E.^. UserId
-                        E.where_ $ uadmin E.^. UserAdminSchool    `E.in_` schools
-                    )
+                    E.exists . E.from $ \ufunc -> E.where_ $ ufunc E.^. UserFunctionUser E.==. user E.^. UserId
+                                                       E.&&. ufunc E.^. UserFunctionFunction `E.in_` schools
            )
          ]
      , dbtFilterUI  = \mPrev -> mconcat
@ -199,56 +183,57 @@ getAdminUserR = postAdminUserR
 postAdminUserR uuid = do
    adminId <- requireAuthId
    uid <- decrypt uuid
-    let fromSchoolList = Set.fromList . map (userAdminSchool . entityVal)
-    let unValueRights (school, E.Value isAdmin, E.Value isLecturer) = (school,isAdmin,isLecturer)
-    (user@User{..}, fromSchoolList -> adminSchools, fmap unValueRights -> userRights) <- runDB $ (,,)
-        <$> get404 uid
-        <*> selectList [UserAdminUser ==. adminId] []
-        <*> E.select ( E.from $ \school -> do
-              E.orderBy [E.asc $ school E.^. SchoolName]
-              let schAdmin    = E.exists $ E.from $ \userAdmin    -> do
-                    E.where_ $ userAdmin    E.^. UserAdminSchool    E.==. school E.^. SchoolId
-                    E.where_ $ userAdmin    E.^. UserAdminUser      E.==. E.val uid
-              let schLecturer = E.exists $ E.from $ \userLecturer -> do
-                    E.where_ $ userLecturer E.^. UserLecturerSchool E.==. school E.^. SchoolId
-                    E.where_ $ userLecturer E.^. UserLecturerUser   E.==. E.val uid
-              return (school,schAdmin,schLecturer)
-            )
+    (user@User{..}, adminSchools, functions, schools) <- runDB $ do
+      user <- get404 uid
+
+      schools <- E.select . E.from $ \(school `E.LeftOuterJoin` userFunction) -> do
+        E.on $ userFunction E.?. UserFunctionSchool E.==. E.just (school E.^. SchoolId)
+         E.&&. userFunction E.?. UserFunctionUser   E.==. E.just (E.val uid)
+        let isAdmin = E.exists . E.from $ \adminFunction ->
+              E.where_ $ adminFunction E.^. UserFunctionUser     E.==. E.val adminId
+                   E.&&. adminFunction E.^. UserFunctionSchool   E.==. school E.^. SchoolId
+                   E.&&. adminFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
+        return (school, userFunction E.?. UserFunctionFunction, isAdmin)
+
+      return ( user
+             , setOf (folded . filtered (view $ _3 . _Value) . _1 . _entityKey) schools
+             , setOf (folded . folding (\x -> (,) <$> preview (_2 . _Value . _Just) x <*> preview (_1 . _entityKey) x)) schools
+             , setOf (folded . _1) schools
+             )
+    let allFunctions = Set.fromList universeF
+        allSchools   = Set.mapMonotonic entityKey schools
+
    -- above data is needed for both form generation and result evaluation
-    let userRightsForm :: Form [(SchoolId, Bool, Bool)]
+    let userRightsForm :: Form (Set (SchoolFunction, SchoolId))
        userRightsForm = identifyForm FIDuserRights $ \csrf -> do
-          boxRights <- forM userRights $ \(school@(Entity sid _), isAdmin, isLecturer) ->
-            if Set.member sid adminSchools
-              then do
-                cbAdmin    <- mreq    checkBoxField "" (Just isAdmin)
-                cbLecturer <- mreq    checkBoxField "" (Just isLecturer)
-                return (school, cbAdmin, cbLecturer)
-              else do
-                cbAdmin    <- mforced checkBoxField ""       isAdmin
-                cbLecturer <- mforced checkBoxField ""       isLecturer
-                return (school, cbAdmin, cbLecturer)
-          let result = forM boxRights $ \(Entity sid _, (resAdmin,_), (resLecturer, _)) ->
-                        (,,) <$> pure sid <*> resAdmin <*> resLecturer
-          return (result,$(widgetFile "widgets/user-rights-form/user-rights-form"))
+          boxRights <- sequence . flip Map.fromSet (allFunctions `setProduct` allSchools) $ \(function, sid) -> if
+            | sid `Set.member` adminSchools
+              -> mpopt   checkBoxField "" . Just $ (function, sid) `Set.member` functions
+            | otherwise
+              -> mforced checkBoxField "" $ (function, sid) `Set.member` functions
+          let result = Map.keysSet . Map.filter id <$> mapM (view _1) boxRights
+          return (result, $(widgetFile "widgets/user-rights-form/user-rights-form"))
        userAuthenticationForm :: Form ButtonAuthMode
        userAuthenticationForm = buttonForm' $ if
          | userAuthentication == AuthLDAP -> [BtnAuthPWHash]
          | otherwise -> [BtnAuthLDAP, BtnPasswordReset]
    let userRightsAction changes = do
-          runDBJobs $ do
-            forM_ changes $ \(sid, userAdmin, userLecturer) ->
-              if Set.notMember sid adminSchools
-                then return ()
-                else do
-                  if userAdmin
-                    then void . insertUnique $ UserAdmin uid sid
-                    else deleteBy $ UniqueUserAdmin uid sid
-                  if userLecturer
-                    then void . insertUnique $ UserLecturer uid sid
-                    else deleteBy $ UniqueSchoolLecturer uid sid
-                -- Note: deleteWhere would not work well here since we filter by adminSchools
-            queueDBJob . JobQueueNotification $ NotificationUserRightsUpdate uid (over _1 (schoolShorthand . entityVal) <$> userRights) -- original rights to check for difference
-          addMessageI Info MsgAccessRightsSaved
+          let symDiff = (changes `Set.difference` functions) `Set.union` (functions `Set.difference` changes)
+              updates = (allFunctions `setProduct` adminSchools) `Set.intersection` symDiff
+          if
+            | not $ Set.null updates -> runDBJobs $ do
+                $logInfoS "user-rights-update" $ tshow updates
+                forM_ updates $ \(function, sid) -> do
+                  $logDebugS "user-rights-update" [st|#{tshow (function, sid)}: #{tshow (Set.member (function, sid) functions)} → #{tshow (Set.member (function,sid) changes)}|]
+                  if
+                    | (function, sid) `Set.member` changes
+                      -> void . insertUnique $ UserFunction uid sid function
+                    | otherwise
+                      -> deleteBy $ UniqueUserFunction uid sid function
+                queueDBJob . JobQueueNotification . NotificationUserRightsUpdate uid $ Set.mapMonotonic (over _2 unSchoolKey) functions -- original rights to check for difference
+                addMessageI Success MsgAccessRightsSaved
+            | otherwise
+              -> addMessageI Info MsgAccessRightsNotChanged
          redirect $ AdminUserR uuid
          
        userAuthenticationAction = \case
@ -435,54 +420,76 @@ postUserPasswordR cID = do
      }


-instance IsInvitableJunction UserLecturer where
-  type InvitationFor UserLecturer = School
-  data InvitableJunction UserLecturer = JunctionUserLecturer
+instance IsInvitableJunction UserFunction where
+  type InvitationFor UserFunction = School
+  data InvitableJunction UserFunction = JunctionUserFunction
+    { jFunction :: SchoolFunction
+    }
    deriving (Eq, Ord, Read, Show, Generic, Typeable)
-  data InvitationDBData UserLecturer = InvDBDataUserLecturer
+  data InvitationDBData UserFunction = InvDBDataUserFunction
+    { invDBUserFunctionDeadline :: UTCTime
+    }
    deriving (Eq, Ord, Read, Show, Generic, Typeable)
-  data InvitationTokenData UserLecturer = InvTokenDataUserLecturer
-    { invTokenUserLecturerSchool :: SchoolShorthand
+  data InvitationTokenData UserFunction = InvTokenDataUserFunction
+    { invTokenUserFunctionSchool :: SchoolShorthand
+    , invTokenUserFunctionFunction :: SchoolFunction
    }
    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _InvitableJunction = iso
-    (\UserLecturer{..} -> (userLecturerUser, userLecturerSchool, JunctionUserLecturer))
-    (\(userLecturerUser, userLecturerSchool, JunctionUserLecturer) -> UserLecturer{..})
+    (\UserFunction{..} -> (userFunctionUser, userFunctionSchool, JunctionUserFunction userFunctionFunction))
+    (\(userFunctionUser, userFunctionSchool, JunctionUserFunction userFunctionFunction) -> UserFunction{..})

-instance ToJSON (InvitableJunction UserLecturer) where
-  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
-  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
-instance FromJSON (InvitableJunction UserLecturer) where
-  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 }
+instance ToJSON (InvitableJunction UserFunction) where
+  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1
+                                        , fieldLabelModifier = camelToPathPiece' 1
+                                        }
+  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 1
+                                                , fieldLabelModifier = camelToPathPiece' 1
+                                                }
+instance FromJSON (InvitableJunction UserFunction) where
+  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1
+                                              , fieldLabelModifier = camelToPathPiece' 1
+                                              }

-instance ToJSON (InvitationDBData UserLecturer) where
-  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
-  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
-instance FromJSON (InvitationDBData UserLecturer) where
-  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
+instance ToJSON (InvitationDBData UserFunction) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+instance FromJSON (InvitationDBData UserFunction) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }

-instance ToJSON (InvitationTokenData UserLecturer) where
-  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
-  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
-instance FromJSON (InvitationTokenData UserLecturer) where
-  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
+instance ToJSON (InvitationTokenData UserFunction) where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }
+instance FromJSON (InvitationTokenData UserFunction) where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 4 }

-lecturerInvitationConfig :: InvitationConfig UserLecturer
-lecturerInvitationConfig = InvitationConfig{..}
+functionInvitationConfig :: InvitationConfig UserFunction
+functionInvitationConfig = InvitationConfig{..}
  where
-    invitationRoute _ _ = return AdminLecturerInviteR
-    invitationResolveFor InvTokenDataUserLecturer{..} = return $ SchoolKey invTokenUserLecturerSchool
-    invitationSubject (Entity _ School{..}) _ = return . SomeMessage $ MsgMailSubjectSchoolLecturerInvitation schoolName
-    invitationHeading (Entity _ School{..}) _ = return . SomeMessage $ MsgMailSchoolLecturerInviteHeading schoolName
-    invitationExplanation _ _ = [ihamlet|_{SomeMessage MsgSchoolLecturerInviteExplanation}|]
-    invitationTokenConfig _ _ = do
+    invitationRoute _ _ = return AdminFunctionaryInviteR
+    invitationResolveFor InvTokenDataUserFunction{..} = return $ SchoolKey invTokenUserFunctionSchool
+    invitationSubject (Entity _ School{..}) (_, InvTokenDataUserFunction{..}) = do
+      MsgRenderer mr <- getMsgRenderer
+      return . SomeMessage . MsgMailSubjectSchoolFunctionInvitation schoolName $ mr invTokenUserFunctionFunction
+    invitationHeading (Entity _ School{..}) (_, InvTokenDataUserFunction{..}) = do
+      MsgRenderer mr <- getMsgRenderer
+      return . SomeMessage . MsgMailSchoolFunctionInviteHeading schoolName $ mr invTokenUserFunctionFunction
+    invitationExplanation _ (_, InvTokenDataUserFunction{..}) = do
+      MsgRenderer mr <- getMsgRenderer
+      return [ihamlet|_{SomeMessage $ MsgSchoolFunctionInviteExplanation (mr $ SomeMessage invTokenUserFunctionFunction)}|]
+    invitationTokenConfig _ (InvDBDataUserFunction{..}, _) = do
      itAuthority <- liftHandlerT requireAuthId
-      return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
+      let itExpiresAt = Just $ Just invDBUserFunctionDeadline
+          itAddAuth = Nothing
+          itStartsAt = Nothing
+      return InvitationTokenConfig{..}
    invitationRestriction _ _ = return Authorized
-    invitationForm _ _ _ = pure $ (JunctionUserLecturer, ())
+    invitationForm _ (_, InvTokenDataUserFunction{..}) _ = pure $ (JunctionUserFunction invTokenUserFunctionFunction, ())
    invitationInsertHook _ _ _ _ = id
-    invitationSuccessMsg (Entity _ School{..}) _ = return . SomeMessage $ MsgSchoolLecturerInvitationAccepted schoolName
+    invitationSuccessMsg (Entity _ School{..}) (Entity _ UserFunction{..}) = do
+      MsgRenderer mr <- getMsgRenderer
+      return . SomeMessage . MsgSchoolFunctionInvitationAccepted schoolName $ mr userFunctionFunction
    invitationUltDest (Entity ssh _) _ = do
      currentTerm <- E.select . E.from $ \term -> do
        E.where_ $ term E.^. TermActive
@ -494,39 +501,50 @@ lecturerInvitationConfig = InvitationConfig{..}
        _other        -> CourseListR
      
      
-getAdminNewLecturerInviteR, postAdminNewLecturerInviteR :: Handler Html
-getAdminNewLecturerInviteR = postAdminNewLecturerInviteR
-postAdminNewLecturerInviteR = do
+getAdminNewFunctionaryInviteR, postAdminNewFunctionaryInviteR :: Handler Html
+getAdminNewFunctionaryInviteR = postAdminNewFunctionaryInviteR
+postAdminNewFunctionaryInviteR = do
  uid <- requireAuthId
  userSchools <- runDB . E.select . E.from $ \userAdmin -> do
-    E.where_ $ userAdmin E.^. UserAdminUser E.==. E.val uid
-    return $ userAdmin E.^. UserAdminSchool
+    E.where_ $ userAdmin E.^. UserFunctionUser E.==. E.val uid
+         E.&&. userAdmin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
+    return $ userAdmin E.^. UserFunctionSchool
  
  ((invitesResult, invitesWgt), invitesEncoding) <- runFormPost . renderWForm FormStandard $ do
-    school <- wreq (schoolFieldFor $ map E.unValue userSchools) (fslI MsgLecturerInviteSchool) Nothing
-    users <- wreq (multiUserField False Nothing) (fslI MsgLecturerInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
-    return $ (,) <$> school <*> users
+    now <- liftIO getCurrentTime
+    let
+      localNow = utcToLocalTime now
+      beginToday = case localTimeToUTC (LocalTime (localDay localNow) midnight) of
+        LTUUnique utc' _ -> utc'
+        _other           -> UTCTime (utctDay now) 0
+      defDeadline = beginToday{ utctDay = 14 `addDays` utctDay beginToday }

-  formResultModal invitesResult UsersR $ \(schoolId, users) -> do
+    function <- wreq (selectField optionsFinite) (fslI MsgFunctionaryInviteFunction) Nothing
+    school   <- wreq (schoolFieldFor $ map E.unValue userSchools) (fslI MsgFunctionaryInviteSchool) Nothing
+    deadline <- wreq utcTimeField (fslI MsgExamRegistrationInviteDeadline) (Just defDeadline)
+    users    <- wreq (multiUserField False Nothing) (fslI MsgFunctionaryInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
+    return $ (,,,) <$> function <*> school <*> deadline <*> users
+
+  formResultModal invitesResult UsersR $ \(function, schoolId, deadline, users) -> do
    let (emails, uids) = partitionEithers $ Set.toList users
    lift . runDBJobs $ do
      forM_ uids $ \lecId ->
-        void . insertUnique $ UserLecturer lecId schoolId
+        void . insertUnique $ UserFunction lecId schoolId function

-      sinkInvitationsF lecturerInvitationConfig [ (mail, schoolId, (InvDBDataUserLecturer, InvTokenDataUserLecturer $ unSchoolKey schoolId)) | mail <- emails ]
+      sinkInvitationsF functionInvitationConfig [ (mail, schoolId, (InvDBDataUserFunction deadline, InvTokenDataUserFunction (unSchoolKey schoolId) function)) | mail <- emails ]

    unless (null emails) $ 
-      tell . pure <=< messageI Success . MsgLecturersInvited $ length emails
+      tell . pure <=< messageI Success . MsgFunctionariesInvited $ length emails
    unless (null uids) $ 
-      tell . pure <=< messageI Success . MsgLecturersAdded $ length uids
+      tell . pure <=< messageI Success . MsgFunctionariesAdded $ length uids

-  siteLayoutMsg MsgLecturerInviteHeading $ do
-    setTitleI MsgLecturerInviteHeading
+  siteLayoutMsg MsgFunctionaryInviteHeading $ do
+    setTitleI MsgFunctionaryInviteHeading
    wrapForm invitesWgt def
      { formEncoding = invitesEncoding
-      , formAction = Just $ SomeRoute AdminNewLecturerInviteR
+      , formAction = Just $ SomeRoute AdminNewFunctionaryInviteR
      }

-getAdminLecturerInviteR, postAdminLecturerInviteR :: Handler Html
-getAdminLecturerInviteR = postAdminLecturerInviteR
-postAdminLecturerInviteR = invitationR lecturerInvitationConfig
+getAdminFunctionaryInviteR, postAdminFunctionaryInviteR :: Handler Html
+getAdminFunctionaryInviteR = postAdminFunctionaryInviteR
+postAdminFunctionaryInviteR = invitationR functionInvitationConfig
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@ -7,7 +7,7 @@ module Handler.Utils.Form.MassInput
  , massInput
  , module Handler.Utils.Form.MassInput.Liveliness
  , massInputA, massInputW
-  , massInputList
+  , massInputList, massInputListA
  , massInputAccum, massInputAccumA, massInputAccumW
  , massInputAccumEdit, massInputAccumEditA, massInputAccumEditW
  , ListLength(..), ListPosition(..), miDeleteList
@ -486,6 +486,22 @@ massInputList field fieldSettings miButtonAction miIdent miSettings miRequired m
  miRequired
  (Map.fromList . zip [0..] . map ((), ) <$> miPrevResult)

+massInputListA :: forall handler cellResult ident.
+                  ( MonadHandler handler, HandlerSite handler ~ UniWorX
+                  , MonadLogger handler
+                  , PathPiece ident
+                  )
+               => Field handler cellResult
+               -> (ListPosition -> FieldSettings UniWorX)
+               -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
+               -> ident
+               -> FieldSettings UniWorX
+               -> Bool
+               -> Maybe [cellResult]
+               -> AForm handler [cellResult]
+massInputListA field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult = formToAForm . fmap (over _2 pure) $ massInputList field fieldSettings miButtonAction miIdent miSettings miRequired miPrevResult mempty
+
+
 -- | Wrapper around `massInput` for the common case, that we just want a list of data with no option to modify it except deletion and addition
 massInputAccum :: forall handler cellData ident.
                  ( MonadHandler handler, HandlerSite handler ~ UniWorX
--- a/src/Handler/Utils/Invitations.hs
+++ b/src/Handler/Utils/Invitations.hs
@ -122,7 +122,7 @@ data InvitationConfig junction = forall formCtx. InvitationConfig
    -- ^ Subject of the e-mail which sends the token to the user
  , invitationHeading     :: Entity (InvitationFor junction) -> InvitationData junction -> DB (SomeMessage UniWorX)
    -- ^ Heading of the page which allows the invitee to accept/decline the invitation (`invitationR`
-  , invitationExplanation :: Entity (InvitationFor junction) -> InvitationData junction -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
+  , invitationExplanation :: Entity (InvitationFor junction) -> InvitationData junction -> DB (HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))
    -- ^ Explanation of what kind of invitation this is (used both in the e-mail and in `invitationR`)
  , invitationTokenConfig :: Entity (InvitationFor junction) -> InvitationData junction -> DB InvitationTokenConfig
    -- ^ Parameters for creating the invitation token (`InvitationTokenData` is handled transparently)
@ -218,7 +218,7 @@ sinkInvitations InvitationConfig{..} = determineExists .| sinkInvitations'
        jwt <- encodeToken token
        jInvitationUrl <- toTextUrl (route, [(toPathPiece GetBearer, toPathPiece jwt)])
        jInvitationSubject <- fmap mr . mapReaderT liftHandlerT $ invitationSubject fEnt dat
-        let jInvitationExplanation = invitationExplanation fEnt dat (toHtml . mr) ur
+        jInvitationExplanation <- (\ihtml -> ihtml (toHtml . mr) ur) <$> mapReaderT liftHandlerT (invitationExplanation fEnt dat)

        when (is _Nothing (ephemeralInvitation @junction)) $ insert_ $ Invitation
                                                                       { invitationEmail = jInvitee
@ -311,7 +311,7 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
    MsgRenderer mr <- getMsgRenderer
    ur <- getUrlRenderParams
    heading <- invitationHeading fEnt iData
-    let explanation = invitationExplanation fEnt iData (toHtml . mr) ur
+    explanation <- (\ihtml -> ihtml (toHtml . mr) ur) <$> invitationExplanation fEnt iData

    fmap (, (dataWidget, dataEnctype), heading, explanation) . formResultMaybe dataRes $ \case
      Nothing -> do
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@ -157,7 +157,7 @@ parseRating File{ fileContent = Just input, .. } = do
    ratingStr = Text.unpack $ Text.strip ratingLine
  ratingPoints <- case () of
    _ | null ratingStr -> return Nothing
-      | otherwise -> either (throw . RatingInvalid) return $ Just <$> readEither ratingStr
+      | otherwise -> either (throw . RatingInvalid . pack) return $ Just <$> readEither ratingStr
  return Rating'{ ratingTime = Just fileModified, .. }
 parseRating _ = throwM RatingFileIsDirectory

--- a/src/Handler/Utils/SchoolLdap.hs
+++ b/src/Handler/Utils/SchoolLdap.hs
@ -0,0 +1,32 @@
+module Handler.Utils.SchoolLdap
+  ( parseLdapSchools
+  ) where
+
+import Import.NoFoundation hiding (try, (<|>), choice)
+
+import Text.Parsec
+import Text.Parsec.Text
+
+import Data.CaseInsensitive (CI)
+import qualified Data.CaseInsensitive as CI
+
+import qualified Data.Set as Set
+  
+
+parseLdapSchools :: Text -> Either ParseError (Set (CI Text))
+parseLdapSchools = parse pLdapSchools ""
+
+pLdapSchools :: Parser (Set (CI Text))
+pLdapSchools = Set.fromList . map CI.mk <$> pSegment `sepBy` char ','
+
+pSegment :: Parser Text
+pSegment = do
+  let
+    fragStart = flip label "fragment start" $ do
+      void . choice . map (try . string) $ sortOn Down
+        [ "l", "st", "o", "ou", "c", "street", "dc" ]
+      void $ char '='
+
+  fragStart
+  pack <$> manyTill anyChar (try (lookAhead $ char ',' >> fragStart) <|> eof)
+  
--- a/src/Handler/Utils/StudyFeatures.hs
+++ b/src/Handler/Utils/StudyFeatures.hs
@ -8,8 +8,8 @@ import Text.Parsec
 import Text.Parsec.Text


-parseStudyFeatures :: UserId -> UTCTime -> Text -> Either Text [StudyFeatures]
-parseStudyFeatures uId now = first tshow . parse (pStudyFeatures uId now <* eof) ""
+parseStudyFeatures :: UserId -> UTCTime -> Text -> Either ParseError [StudyFeatures]
+parseStudyFeatures uId now = parse (pStudyFeatures uId now <* eof) ""


 pStudyFeatures :: UserId -> UTCTime -> Parser [StudyFeatures]
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@ -234,18 +234,14 @@ termCell tid = anchorCell link name
 termCellCL :: IsDBTable m a => CourseLink -> DBCell m a
 termCellCL (tid,_,_) = termCell tid

-schoolCell :: IsDBTable m a => Maybe TermId -> SchoolId -> DBCell m a
-schoolCell (Just tid) ssh  = anchorCell link name
+schoolCell :: IsDBTable m a => TermId -> SchoolId -> DBCell m a
+schoolCell tid ssh  = anchorCell link name
  where
    link = TermSchoolCourseListR tid ssh
    name = toWgt ssh
-schoolCell Nothing ssh  = anchorCell link name
-  where
-    link = SchoolShowR ssh
-    name = toWgt ssh

 schoolCellCL :: IsDBTable m a => CourseLink -> DBCell m a
-schoolCellCL (tid,ssh,_) = schoolCell (Just tid) ssh
+schoolCellCL (tid,ssh,_) = schoolCell tid ssh

 courseCellCL :: IsDBTable m a => CourseLink -> DBCell m a
 courseCellCL (tid,ssh,csh) = anchorCell link name
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@ -102,8 +102,8 @@ fltrTermUI mPrev = prismAForm (singletonFilter "term" . maybePrism _PathPiece) m
 -- Schools --
 -------------

-colSchoolShort :: OpticColonnade SchoolId
-colSchoolShort resultSsh = Colonnade.singleton (fromSortable header) body
+colSchool :: OpticColonnade SchoolId
+colSchool resultSsh = Colonnade.singleton (fromSortable header) body
  where
    header = Sortable (Just "school") (i18nCell MsgSchool)
    body = i18nCell . unSchoolKey . view resultSsh
@ -111,6 +111,24 @@ colSchoolShort resultSsh = Colonnade.singleton (fromSortable header) body
 sortSchool :: OpticSortColumn SchoolId
 sortSchool querySsh = singletonMap "school" . SortColumn $ view querySsh

+colSchoolShort :: OpticColonnade SchoolId
+colSchoolShort resultSsh = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "school-short") (i18nCell MsgSchoolShort)
+    body = i18nCell . unSchoolKey . view resultSsh
+
+sortSchoolShort :: OpticSortColumn SchoolId
+sortSchoolShort querySsh = singletonMap "school-short" . SortColumn $ view querySsh
+  
+colSchoolName :: OpticColonnade SchoolName
+colSchoolName resultSn = Colonnade.singleton (fromSortable header) body
+  where
+    header = Sortable (Just "school-name") (i18nCell MsgSchoolName)
+    body = i18nCell . view resultSn
+
+sortSchoolName :: OpticSortColumn SchoolName
+sortSchoolName querySn = singletonMap "school-name" . SortColumn $ view querySn
+  
 fltrSchool :: OpticFilterColumn t SchoolId
 fltrSchool querySsh = singletonMap "school" . FilterColumn $ mkExactFilter (view querySsh)

--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@ -66,6 +66,7 @@ import Jobs.Handler.SendCourseCommunication
 import Jobs.Handler.Invitation
 import Jobs.Handler.SendPasswordReset
 import Jobs.Handler.TransactionLog
+import Jobs.Handler.SynchroniseLdap
 import Jobs.Handler.PruneInvitations

 import Jobs.HealthReport
@ -429,11 +430,19 @@ jLocked jId act = do
 pruneLastExecs :: Crontab JobCtl -> DB ()
 pruneLastExecs crontab = runConduit $ selectSource [] [] .| C.mapM_ ensureCrontab
  where
-    ensureCrontab (Entity leId CronLastExec{..})
-      | Just job <- Aeson.parseMaybe parseJSON cronLastExecJob
-      , HashMap.member (JobCtlQueue job) crontab
-      = return ()
-      | otherwise = delete leId
+    ensureCrontab (Entity leId CronLastExec{..}) = void . runMaybeT $ do
+      now <- liftIO getCurrentTime
+      flushInterval <- MaybeT . getsYesod . view $ appSettings . _appJobFlushInterval
+      
+  
+      if
+        | abs (now `diffUTCTime` cronLastExecTime) > flushInterval * 2
+          -> return ()
+        | Just job <- Aeson.parseMaybe parseJSON cronLastExecJob
+        , HashMap.member (JobCtlQueue job) crontab
+          -> return ()
+        | otherwise
+          -> lift $ delete leId

 determineCrontab' :: DB (Crontab JobCtl)
 determineCrontab' = (\ct -> ct <$ pruneLastExecs ct) =<< determineCrontab
--- a/src/Jobs/Crontab.hs
+++ b/src/Jobs/Crontab.hs
@ -11,6 +11,7 @@ import qualified Data.Map as Map
 import Data.Semigroup (Max(..))

 import Data.Time.Zones
+import Data.Time.Clock.POSIX

 import Handler.Utils.DateTime

@ -25,7 +26,7 @@ import qualified Database.Esqueleto as E
 determineCrontab :: DB (Crontab JobCtl)
 -- ^ Extract all future jobs from the database (sheet deadlines, ...)
 determineCrontab = execWriterT $ do
-  AppSettings{..} <- getsYesod appSettings'
+  UniWorX{ appSettings' = AppSettings{..}, .. } <- getYesod

  case appJobFlushInterval of
    Just interval -> tell $ HashMap.singleton
@ -96,6 +97,48 @@ determineCrontab = execWriterT $ do
        , cronNotAfter  = Right CronNotScheduled
        }

+
+  if
+    | is _Just appLdapConf
+    , is _Just appLdapConf
+    , Just syncWithin <- appSynchroniseLdapUsersWithin
+      -> do
+        now <- liftIO getPOSIXTime
+        let
+          interval = appSynchroniseLdapUsersInterval
+          
+          (ldapEpoch, epochNow) = now `divMod'` syncWithin
+          ldapInterval = epochNow `div'` interval
+          numIntervals = floor $ syncWithin / interval
+
+          nextIntervals = do
+            let
+              n = ceiling $ 4 * appJobCronInterval / appSynchroniseLdapUsersInterval
+            i <- [negate (ceiling $ n % 2) .. ceiling $ n % 2]
+            let
+              ((+ ldapEpoch) -> nextEpoch, nextInterval) = (ldapInterval + i) `divMod` numIntervals
+              nextIntervalTime
+                = posixSecondsToUTCTime $ fromInteger nextEpoch * syncWithin + fromInteger nextInterval * interval
+            return (nextEpoch, nextInterval, nextIntervalTime)
+
+        forM_ nextIntervals $ \(nextEpoch, nextInterval, nextIntervalTime) -> do
+          $logDebugS "SynchroniseLdap" [st|currentTime: #{tshow ldapEpoch}.#{tshow epochNow}; upcomingSync: #{tshow nextEpoch}.#{tshow (fromInteger nextInterval * interval)}; upcomingData: #{tshow (numIntervals, nextEpoch, nextInterval)}|]
+          tell $ HashMap.singleton
+            (JobCtlQueue JobSynchroniseLdap
+               { jEpoch         = fromInteger nextEpoch
+               , jNumIterations = fromInteger numIntervals
+               , jIteration     = fromInteger nextInterval
+               })
+            Cron
+              { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ nextIntervalTime
+              , cronRepeat    = CronRepeatNever
+              , cronRateLimit = appSynchroniseLdapUsersInterval
+              , cronNotAfter  = Left syncWithin
+              }
+    | otherwise
+      -> return ()
+    
+
  let
    sheetJobs (Entity nSheet Sheet{..}) = do
      tell $ HashMap.singleton
--- a/src/Jobs/Handler/QueueNotification.hs
+++ b/src/Jobs/Handler/QueueNotification.hs
@ -2,9 +2,9 @@ module Jobs.Handler.QueueNotification
  ( dispatchJobQueueNotification
  ) where

-import Import hiding ((\\))
+import Import

-import Data.List (nub, (\\))
+import Data.List (nub)

 import Jobs.Types

@ -12,6 +12,8 @@ import qualified Database.Esqueleto as E
 import Utils.Sql
 import Jobs.Queue

+import qualified Data.Set as Set
+

 dispatchJobQueueNotification :: Notification -> Handler ()
 dispatchJobQueueNotification jNotification = runDBJobs . setSerializable $ do
@ -59,14 +61,15 @@ determineNotificationCandidates NotificationUserRightsUpdate{..} = do
  -- always send to affected user
  affectedUser <- selectList [UserId ==. nUser] []
  -- send to same-school admins only if there was an update
-  currentAdminSchools <- fmap (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. nUser] []
-  let oldAdminSchools = [ SchoolKey ssh | (ssh, True, _) <- nOriginalRights ]
-      newAdminSchools = currentAdminSchools \\ oldAdminSchools
+  currentAdminSchools <- setOf (folded . _entityVal . _userFunctionSchool) <$> selectList [UserFunctionUser ==. nUser, UserFunctionFunction ==. SchoolAdmin] []
+  let oldAdminSchools = setOf (folded . filtered ((== SchoolAdmin) . view _1) . _2 . from _SchoolId) nOriginalRights
+      newAdminSchools = currentAdminSchools `Set.difference` oldAdminSchools
  affectedAdmins <- E.select . E.from $ \(user `E.InnerJoin` admin) -> do
-    E.on $ admin E.^. UserAdminUser E.==. user E.^. UserId
-    E.where_ $ admin E.^. UserAdminSchool `E.in_` E.valList newAdminSchools
+    E.on $ admin E.^. UserFunctionUser E.==. user E.^. UserId
+    E.where_ $ admin E.^. UserFunctionSchool `E.in_` E.valList (Set.toList newAdminSchools)
+         E.&&. admin E.^. UserFunctionFunction E.==. E.val SchoolAdmin
    return user
-  return $ nub $ affectedUser <> affectedAdmins
+  return . nub $ affectedUser <> affectedAdmins
 determineNotificationCandidates NotificationUserAuthModeUpdate{..}
  = selectList [UserId ==. nUser] []
 determineNotificationCandidates notif@NotificationExamResult{..} = do
--- a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs
+++ b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs
@ -6,24 +6,25 @@ module Jobs.Handler.SendNotification.UserRightsUpdate

 import Import

-import Handler.Utils.Database
 import Handler.Utils.Mail
 import Jobs.Handler.SendNotification.Utils

+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
 import Text.Hamlet
 -- import qualified Data.CaseInsensitive as CI

-dispatchNotificationUserRightsUpdate :: UserId -> [(SchoolShorthand,Bool,Bool)]-> UserId -> Handler ()
+dispatchNotificationUserRightsUpdate :: UserId -> Set (SchoolFunction, SchoolShorthand) -> UserId -> Handler ()
 dispatchNotificationUserRightsUpdate  nUser _originalRights jRecipient = userMailT jRecipient $ do
-    (User{..}, adminSchools, lecturerSchools)  <-  liftHandlerT . runDB $ do
-      user <-getJust nUser
-      adminSchools    <- getSchoolsOf nUser UserAdminSchool    UserAdminUser
-      lecturerSchools <- getSchoolsOf nUser UserLecturerSchool UserLecturerUser
-      return (user,adminSchools,lecturerSchools)
+    (User{..}, functions)  <-  liftHandlerT . runDB $ do
+      user <- getJust nUser
+      functions <- Map.fromListWith Set.union . map (\(Entity _ UserFunction{..}) -> (userFunctionFunction, Set.singleton userFunctionSchool)) <$> selectList [UserFunctionUser ==. nUser] []
+      return (user, functions)
    replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
    setSubjectI $ MsgMailSubjectUserRightsUpdate userDisplayName
    -- MsgRenderer mr <- getMailMsgRenderer
    editNotifications <- mkEditNotifications jRecipient
    addAlternatives $
-      providePreferredAlternative ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+      providePreferredAlternative ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX))

--- a/src/Jobs/Handler/SendNotification/Utils.hs
+++ b/src/Jobs/Handler/SendNotification/Utils.hs
@ -1,5 +1,6 @@
 module Jobs.Handler.SendNotification.Utils
  ( mkEditNotifications
+  , ihamletSomeMessage
  ) where

 import Import
@ -9,6 +10,9 @@ import Text.Hamlet
 import qualified Data.HashSet as HashSet


+ihamletSomeMessage :: HtmlUrlI18n UniWorXMessage (Route UniWorX) -> HtmlUrlI18n (SomeMessage UniWorX) (Route UniWorX)
+ihamletSomeMessage f trans = f $ trans . SomeMessage
+  
 mkEditNotifications :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (HtmlUrlI18n UniWorXMessage (Route UniWorX))
 mkEditNotifications uid = liftHandlerT $ do
  cID <- encrypt uid
--- a/src/Jobs/Handler/SynchroniseLdap.hs
+++ b/src/Jobs/Handler/SynchroniseLdap.hs
@ -0,0 +1,55 @@
+module Jobs.Handler.SynchroniseLdap
+  ( dispatchJobSynchroniseLdap
+  , SynchroniseLdapException(..)
+  ) where
+
+import Import
+
+import qualified Data.Conduit.List as C
+import qualified Data.CaseInsensitive as CI
+
+import Auth.LDAP
+
+data SynchroniseLdapException
+  = SynchroniseLdapNoLdap
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+instance Exception SynchroniseLdapException
+
+dispatchJobSynchroniseLdap :: Natural -> Natural -> Natural -> Handler ()
+dispatchJobSynchroniseLdap numIterations epoch iteration = do
+  UniWorX{ appSettings' = AppSettings{..}, .. } <- getYesod
+  case (,) <$> appLdapConf <*> appLdapPool of
+    Just (ldapConf, ldapPool) -> 
+      runDB . runConduit $
+        readUsers .| filterIteration .| synchroniseUser ldapConf ldapPool
+    Nothing ->
+      throwM SynchroniseLdapNoLdap
+  where
+    readUsers :: Source (YesodDB UniWorX) UserId
+    readUsers = selectKeys [] []
+
+    filterIteration :: Conduit UserId (YesodDB UniWorX) User
+    filterIteration = C.mapMaybeM $ \userId -> runMaybeT $ do
+      let
+        userIteration, currentIteration :: Integer
+        userIteration = toInteger (hash epoch `hashWithSalt` userId) `mod` toInteger numIterations
+        currentIteration = toInteger iteration `mod` toInteger numIterations
+      $logDebugS "SynchroniseLdap" [st|User ##{tshow (fromSqlKey userId)}: sync on #{tshow userIteration}/#{tshow numIterations}, now #{tshow currentIteration}|]
+      guard $ userIteration == currentIteration
+
+      MaybeT $ get userId
+
+    synchroniseUser :: LdapConf -> LdapPool -> Sink User (YesodDB UniWorX) ()
+    synchroniseUser conf pool = C.mapM_ $ \user -> void . runMaybeT . handleExc $ do
+      $logInfoS "SynchroniseLdap" [st|Synchronising #{userIdent user}|]
+      
+      ldapAttrs <- MaybeT $ campusUser' conf pool user
+      void . lift $ upsertCampusUser ldapAttrs Creds
+        { credsIdent  = CI.original $ userIdent user
+        , credsPlugin = "dummy"
+        , credsExtra  = []
+        }
+      where
+        handleExc
+          = catchMPlus (Proxy @CampusUserException)
+          . catchMPlus (Proxy @CampusUserConversionException)
--- a/src/Jobs/Queue.hs
+++ b/src/Jobs/Queue.hs
@ -80,6 +80,7 @@ writeJobCtlBlock = writeJobCtlBlock' writeJobCtl

 queueJobUnsafe :: Bool -> Job -> YesodDB UniWorX QueuedJobId
 queueJobUnsafe queuedJobWriteLastExec job = do
+  $logInfoS "queueJob" $ tshow job
  queuedJobCreationTime <- liftIO getCurrentTime
  queuedJobCreationInstance <- getsYesod appInstanceID
  insert QueuedJob
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@ -51,6 +51,10 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
         | JobTruncateTransactionLog
         | JobPruneInvitations
         | JobDeleteTransactionLogIPs
+         | JobSynchroniseLdap { jNumIterations
+                              , jEpoch
+                              , jIteration :: Natural
+                              }
  deriving (Eq, Ord, Show, Read, Generic, Typeable)
 data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                  | NotificationSheetActive { nSheet :: SheetId }
@ -58,7 +62,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                  | NotificationSheetInactive { nSheet :: SheetId }
                  | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId }
                  | NotificationCorrectionsNotDistributed { nSheet :: SheetId }
-                  | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: [(SchoolShorthand,Bool,Bool)] } -- User rights (admin, lecturer,...) were changed somehow
+                  | NotificationUserRightsUpdate { nUser :: UserId, nOriginalRights :: Set (SchoolFunction, SchoolShorthand) }
                  | NotificationUserAuthModeUpdate { nUser :: UserId, nOriginalAuthMode :: AuthenticationMode }
                  | NotificationExamResult { nExam :: ExamId }
  deriving (Eq, Ord, Show, Read, Generic, Typeable)
--- a/src/Ldap/Client/Pool.hs
+++ b/src/Ldap/Client/Pool.hs
@ -103,7 +103,7 @@ createLdapPool host port stripes timeoutConn (round . (* 1e6) -> timeoutAct) lim
        setup <- liftIO newEmptyTMVarIO

        ldapAsync <- allocateAsync . flip runLoggingT logFunc $ do
-          $logInfoS "LdapExecutor" "Starting"
+          $logDebugS "LdapExecutor" "Starting"
          res <- liftIO . Ldap.with host port $ flip runLoggingT logFunc . go (Just setup)
          case res of
            Left exc -> do
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@ -454,6 +454,37 @@ customMigrations = Map.fromListWith (>>)
        whenM (tableExists "allocation_deregister") $ do
          [executeQQ|ALTER TABLE allocation_deregister DROP COLUMN IF EXISTS allocation;|]
    )
+  , ( AppliedMigrationKey [migrationVersion|18.0.0|] [version|19.0.0|]
+    , do
+        [executeQQ|
+          CREATe TABLE IF NOT EXISTS "user_function" ( "id" serial8 primary key, "user" bigint, "school" citext, "function" text );
+        |]
+
+        whenM (tableExists "user_admin") $ do
+          let getAdminEntries = rawQuery [st|SELECT user_admin.id, user_admin.user, user_admin.school FROM user_admin;|] []
+              moveAdminEntry [fromPersistValue -> Right (eId :: Int64), fromPersistValue -> Right (uid :: UserId), fromPersistValue -> Right (sid :: SchoolId)] =
+                [executeQQ|
+                  INSERT INTO "user_function" ("user", "school", "function") VALUES (#{uid}, #{sid}, #{SchoolAdmin});
+                  DELETE FROM "user_admin" WHERE "id" = #{eId};
+                |]
+              moveAdminEntry _ = return ()
+          runConduit $ getAdminEntries .| C.mapM_ moveAdminEntry
+          tableDropEmpty "user_admin"
+        whenM (tableExists "user_lecturer") $ do
+          let getLecturerEntries = rawQuery [st|SELECT user_lecturer.id, user_lecturer.user, user_lecturer.school FROM user_lecturer;|] []
+              moveLecturerEntry [fromPersistValue -> Right (eId :: Int64), fromPersistValue -> Right (uid :: UserId), fromPersistValue -> Right (sid :: SchoolId)] =
+                [executeQQ|
+                  INSERT INTO "user_function" ("user", "school", "function") VALUES (#{uid}, #{sid}, #{SchoolLecturer});
+                  DELETE FROM "user_lecturer" WHERE "id" = #{eId};
+                |]
+              moveLecturerEntry _ = return ()
+          runConduit $ getLecturerEntries .| C.mapM_ moveLecturerEntry
+          tableDropEmpty "user_lecturer"
+        whenM (tableExists "invitation") $ do
+          [executeQQ|
+            DELETE FROM "invitation" WHERE "for"->'junction' = '"UserLecturer"';
+          |]
+    )
  ]


--- a/src/Model/Rating.hs
+++ b/src/Model/Rating.hs
@ -25,7 +25,7 @@ data Rating' = Rating'
 data RatingException = RatingNotUnicode UnicodeException -- ^ Rating failed to parse as unicode
                     | RatingMissingSeparator -- ^ Could not split rating header from comments
                     | RatingMultiple -- ^ Encountered multiple point values in rating
-                     | RatingInvalid String -- ^ Failed to parse rating point value
+                     | RatingInvalid Text -- ^ Failed to parse rating point value
                     | RatingFileIsDirectory -- ^ We do not expect this to, it's included for totality
                     | RatingNegative -- ^ Rating points must be non-negative
                     | RatingExceedsMax -- ^ Rating point must not exceed maximum points
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@ -12,3 +12,4 @@ import Model.Types.Security as Types
 import Model.Types.Sheet as Types
 import Model.Types.Submission as Types
 import Model.Types.Misc as Types
+import Model.Types.School as Types
--- a/src/Model/Types/School.hs
+++ b/src/Model/Types/School.hs
@ -0,0 +1,19 @@
+module Model.Types.School where
+
+import Import.NoModel
+import Model.Types.TH.PathPiece
+
+data SchoolFunction
+  = SchoolAdmin
+  | SchoolLecturer
+  | SchoolEvaluation
+  | SchoolExamOffice
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+instance Universe SchoolFunction
+instance Finite SchoolFunction
+instance Hashable SchoolFunction
+
+nullaryPathPiece ''SchoolFunction $ camelToPathPiece' 1
+pathPieceJSON ''SchoolFunction
+pathPieceJSONKey ''SchoolFunction
+derivePersistFieldPathPiece ''SchoolFunction
--- a/src/Model/Types/TH/PathPiece.hs
+++ b/src/Model/Types/TH/PathPiece.hs
@ -0,0 +1,47 @@
+module Model.Types.TH.PathPiece
+  ( derivePersistFieldPathPiece
+  ) where
+
+import ClassyPrelude.Yesod
+import Data.List (foldl)
+import Database.Persist.Sql
+
+import qualified Data.Text.Encoding as Text
+
+import Language.Haskell.TH
+import Language.Haskell.TH.Datatype
+
+
+derivePersistFieldPathPiece :: Name -> DecsQ
+derivePersistFieldPathPiece tName = do
+  DatatypeInfo{..} <- reifyDatatype tName
+  vars <- forM datatypeVars (const $ newName "a")
+  let t = foldl (\t' n' -> t' `appT` varT n') (conT tName) vars
+      iCxt
+        | null vars = cxt []
+        | otherwise = cxt [[t|PathPiece|] `appT` t]
+      sqlCxt
+        | null vars = cxt []
+        | otherwise = cxt [[t|PersistField|] `appT` t]
+  sequence
+    [ instanceD iCxt ([t|PersistField|] `appT` t)
+      [ funD 'toPersistValue
+        [ clause [] (normalB [e|PersistText . toPathPiece|]) []
+        ]
+      , funD 'fromPersistValue
+        [ do
+            bs <- newName "bs"
+            clause [[p|PersistByteString $(varP bs)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistByteString") Right $ fromPathPiece =<< either (const Nothing) Just (Text.decodeUtf8' $(varE bs))|]) []
+        , do
+            text <- newName "text"
+            clause [[p|PersistText $(varP text)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistTetx") Right $ fromPathPiece $(varE text)|]) []
+        , clause [wildP] (normalB [e|Left "PathPiece values must be converted from PersistText or PersistByteString"|]) []
+        ]
+      ]
+    , instanceD sqlCxt ([t|PersistFieldSql|] `appT` t)
+      [ funD 'sqlType
+        [ clause [wildP] (normalB [e|SqlString|]) []
+        ]
+      ]
+    ]
+
--- a/src/Settings.hs
+++ b/src/Settings.hs
@ -118,6 +118,9 @@ data AppSettings = AppSettings
    , appHealthCheckHTTP        :: Bool
    , appHealthCheckActiveJobExecutorsTimeout :: NominalDiffTime

+    , appSynchroniseLdapUsersWithin :: Maybe NominalDiffTime
+    , appSynchroniseLdapUsersInterval :: NominalDiffTime
+
    , appInitialLogSettings     :: LogSettings

    , appTransactionLogIPRetentionTime :: NominalDiffTime
@ -396,6 +399,9 @@ instance FromJSON AppSettings where

        appSessionTimeout         <- o .: "session-timeout"

+        appSynchroniseLdapUsersWithin <- o .:? "synchronise-ldap-users-within"
+        appSynchroniseLdapUsersInterval <- o .:  "synchronise-ldap-users-interval"
+
        appMaximumContentLength   <- o .: "maximum-content-length"

        appReloadTemplates        <- o .:? "reload-templates" .!= defaultDev
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -51,7 +51,7 @@ import Control.Arrow as Utils ((>>>))
 import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
 import Control.Monad.Except (MonadError(..))
 import Control.Monad.Trans.Maybe as Utils (MaybeT(..))
-import Control.Monad.Catch hiding (throwM)
+import Control.Monad.Catch (catchIf)

 import Language.Haskell.TH
 import Language.Haskell.TH.Instances ()
@ -395,6 +395,9 @@ setIntersections (h:t) = foldl' Set.intersection h t
 setMapMaybe :: (Ord a, Ord b) => (a -> Maybe b) -> Set a -> Set b
 setMapMaybe f = Set.fromList . mapMaybe f . Set.toList

+setProduct :: (Ord a, Ord b) => Set a -> Set b -> Set (a, b)
+setProduct (Set.toAscList -> as) (Set.toAscList -> bs) = Set.fromDistinctAscList $ (,) <$> as <*> bs
+
 ----------
 -- Maps --
 ----------
@ -494,6 +497,12 @@ hoistMaybe = maybe mzero return
 catchIfMaybeT :: (MonadCatch m, Exception e) => (e -> Bool) -> m a -> MaybeT m a
 catchIfMaybeT p act = catchIf p (lift act) (const mzero)

+catchMaybeT :: forall p m e a. (MonadCatch m, Exception e) => p e -> m a -> MaybeT m a
+catchMaybeT _ act = catch (lift act) (const mzero :: e -> MaybeT m a)
+
+catchMPlus :: forall p m e a. (MonadPlus m, MonadCatch m, Exception e) => p e -> m a -> m a
+catchMPlus _ = handle (const mzero :: e -> m a)
+
 mcons :: Maybe a -> [a] -> [a]
 mcons Nothing  xs = xs
 mcons (Just x) xs = x:xs
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@ -43,6 +43,9 @@ _nullable = prism' toNullable fromNullable
 _SchoolId :: Iso' SchoolId SchoolShorthand
 _SchoolId = iso unSchoolKey SchoolKey

+_Maybe :: Iso' (Maybe ()) Bool
+_Maybe = iso (is _Just) (bool Nothing (Just ()))
+

 -----------------------------------
 -- Lens Definitions for our Types
@ -169,6 +172,11 @@ makeLenses_ ''Allocation

 makeLenses_ ''File

+makeLenses_ ''School
+makeLenses_ ''SchoolLdap
+
+makeLenses_ ''UserFunction
+

 -- makeClassy_ ''Load

--- a/start.sh
+++ b/start.sh
@ -4,13 +4,15 @@ set -e

 [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || :

-unset HOST
+__HOST=${HOST:-$(hostname -s | awk '{ print $0; }')}
+
 export DETAILED_LOGGING=${DETAILED_LOGGIN:-true}
 export LOG_ALL=${LOG_ALL:-false}
 export LOGLEVEL=${LOGLEVEL:-info}
 export DUMMY_LOGIN=${DUMMY_LOGIN:-true}
 export ALLOW_DEPRECATED=${ALLOW_DEPRECATED:-true}
-export RIBBON=${RIBBON:-Localhost}
+export RIBBON=${RIBBON:-${__HOST:-localhost}}
+unset HOST

 move-back() {
    mv -v .stack-work .stack-work-run
--- a/templates/mail/userRightsUpdate.hamlet
+++ b/templates/mail/userRightsUpdate.hamlet
@ -11,25 +11,21 @@ $newline never
      }
  <body>
    <h1>
-      _{MsgMailUserRightsIntro userDisplayName userEmail}
-    $with numSchools <- length adminSchools
-      $if numSchools > 0
-        <p>
-          <h2>_{MsgAdminFor} _{MsgForSchools numSchools}
+      _{SomeMessage $ MsgMailUserRightsIntro userDisplayName userEmail}
+    <dl>
+      $forall (function, schools) <- Map.toList functions
+        <dt>_{SomeMessage $ function}
+        <dd>
          <ul>
-            $forall sn <- adminSchools
-              <li>#{sn}
-    $with numSchools <- length lecturerSchools
+            $forall sn <- schools
+              <li>
+                #{sn}
+    $with numSchools <- maybe 0 Set.size $ Map.lookup SchoolLecturer functions
      $if numSchools > 0
-        <p>
-          <h2>_{MsgLecturerFor} _{MsgForSchools numSchools}
-          <ul>
-            $forall sn <- lecturerSchools
-              <li>#{sn}
        <p>
          <a href=@{CourseNewR}>
-            _{MsgMailLecturerRights numSchools}
+            _{SomeMessage $ MsgMailLecturerRights numSchools}
      $else
-        <p>_{MsgMailNoLecturerRights}
+        <p>_{SomeMessage $ MsgMailNoLecturerRights}

-    ^{editNotifications}
+    ^{ihamletSomeMessage editNotifications}
--- a/templates/profileData.hamlet
+++ b/templates/profileData.hamlet
@ -16,22 +16,13 @@
          #{llogin}
        $nothing
          _{MsgNever}
-    $if not $ null admin_rights
-      <dt .deflist__dt>_{MsgAdminFor}
+    $forall (function, schools) <- Map.toList functions
+      <dt .deflist__dt>_{function}
      <dd .deflist__dd>
        <ul .list-ul>
-          $forall (E.Value institute) <- admin_rights
+          $forall ssh <- schools
            <li .list-ul__item>
-              <a href=@{SchoolShowR $ SchoolKey institute}>
-                #{institute}
-    $if not $ null lecturer_rights
-      <dt .deflist__dt>_{MsgLecturerFor}
-      <dd .deflist__dd>
-        <ul .list-ul>
-          $forall (E.Value institute) <- lecturer_rights
-            <li .list-ul__item>
-              <a href=@{SchoolShowR $ SchoolKey institute}>
-                #{institute}
+              #{ssh}
    $if not $ null lecture_corrector
      <dt .deflist__dt> Korrektor
      <dd .deflist__dd>
--- a/templates/widgets/massinput/list/layout.hamlet
+++ b/templates/widgets/massinput/list/layout.hamlet
@ -1,14 +1,10 @@
 $newline never
-<table>
-  <tbody>
-    $forall coord <- review liveCoords lLength
-      <tr .massinput__cell>
-        <td>
-          ^{cellWdgts ! coord}
-        <td>
-          ^{fvInput (delButtons ! coord)}
-  <tfoot>
-    <tr .massinput__cell.massinput__cell--add>
-      <td>
-      <td>
-        ^{addWdgts ! (0, 0)}
+<div .massinput-list__wrapper>
+  $forall coord <- review liveCoords lLength
+    <div .massinput-list__cell .massinput__cell>
+      <div .massinput-list__field>
+        ^{cellWdgts ! coord}
+      <div .massinput-list__delete>
+        ^{fvInput (delButtons ! coord)}
+  <div .massinput-list__add .massinput__cell .massinput__cell--add>
+    ^{addWdgts ! (0, 0)}
--- a/templates/widgets/user-rights-form/user-rights-form.hamlet
+++ b/templates/widgets/user-rights-form/user-rights-form.hamlet
@ -5,10 +5,15 @@ $newline never
    <tr .table__row .table__row--head>
      <th>
        $# empty cell
-      <th .table__th>_{MsgAdminFor}
-      <th .table__th>_{MsgLecturerFor}
-    $forall (Entity _ (School name _), (_,cbAdmin), (_,cbLecturer)) <- boxRights
-      <tr .table__row>
-        <th .table__th>#{name}
-        <td .table__td>^{fvInput cbAdmin}
-        <td .table__td>^{fvInput cbLecturer}
+      $forall function <- allFunctions
+        <th .table__th>
+          _{function}
+    $forall school <- schools
+      $with Entity sid School{schoolName} <- school
+        <tr .table__row>
+          <th .table__th>
+            #{schoolName}
+          $forall function <- allFunctions
+            <td .table__td>
+              $maybe (_, boxView) <- Map.lookup (function, sid) boxRights
+                ^{fvInput boxView}
--- a/test/Database.hs
+++ b/test/Database.hs
@ -106,6 +106,8 @@ fillDb = do
    , userWarningDays = userDefaultWarningDays
    , userMailLanguages = MailLanguages ["en"]
    , userNotificationSettings = def
+    , userCreated = now
+    , userLastLdapSynchronisation = Nothing
    }
  fhamann <- insert User
    { userIdent  = "felix.hamann@campus.lmu.de"
@ -127,6 +129,8 @@ fillDb = do
    , userWarningDays = userDefaultWarningDays
    , userMailLanguages = MailLanguages ["de"]
    , userNotificationSettings = def
+    , userCreated = now
+    , userLastLdapSynchronisation = Nothing
    }
  jost <- insert User
    { userIdent  = "jost@tcs.ifi.lmu.de"
@ -148,6 +152,8 @@ fillDb = do
    , userWarningDays = userDefaultWarningDays
    , userMailLanguages = MailLanguages ["de"]
    , userNotificationSettings = def
+    , userCreated = now
+    , userLastLdapSynchronisation = Nothing
    }
  maxMuster <- insert User
    { userIdent  = "max@campus.lmu.de"
@ -169,6 +175,8 @@ fillDb = do
    , userWarningDays = userDefaultWarningDays
    , userMailLanguages = MailLanguages ["de"]
    , userNotificationSettings = def
+    , userCreated = now
+    , userLastLdapSynchronisation = Nothing
    }
  tinaTester <- insert $ User
    { userIdent  = "tester@campus.lmu.de"
@ -190,6 +198,8 @@ fillDb = do
    , userWarningDays = userDefaultWarningDays
    , userMailLanguages = MailLanguages ["de"]
    , userNotificationSettings = def
+    , userCreated = now
+    , userLastLdapSynchronisation = Nothing
    }
  svaupel <- insert User
    { userIdent  = "vaupel.sarah@campus.lmu.de"
@ -211,6 +221,8 @@ fillDb = do
    , userWarningDays = userDefaultWarningDays
    , userMailLanguages = MailLanguages ["de"]
    , userNotificationSettings = def
+    , userCreated = now
+    , userLastLdapSynchronisation = Nothing
    }
  void . repsert (TermKey summer2017) $ Term
    { termName     = summer2017
@ -241,17 +253,17 @@ fillDb = do
    }
  ifi <- insert' $ School "Institut für Informatik" "IfI"
  mi  <- insert' $ School "Institut für Mathematik" "MI"
-  void . insert' $ UserAdmin gkleen ifi
-  void . insert' $ UserAdmin gkleen mi
-  void . insert' $ UserAdmin fhamann ifi
-  void . insert' $ UserAdmin jost ifi
-  void . insert' $ UserAdmin jost mi
-  void . insert' $ UserAdmin svaupel ifi
-  void . insert' $ UserAdmin svaupel mi
-  void . insert' $ UserLecturer gkleen ifi
-  void . insert' $ UserLecturer fhamann ifi
-  void . insert' $ UserLecturer jost ifi
-  void . insert' $ UserLecturer svaupel ifi
+  void . insert' $ UserFunction gkleen ifi SchoolAdmin
+  void . insert' $ UserFunction gkleen mi SchoolAdmin
+  void . insert' $ UserFunction fhamann ifi SchoolAdmin
+  void . insert' $ UserFunction jost ifi SchoolAdmin
+  void . insert' $ UserFunction jost mi SchoolAdmin
+  void . insert' $ UserFunction svaupel ifi SchoolAdmin
+  void . insert' $ UserFunction svaupel mi SchoolAdmin
+  void . insert' $ UserFunction gkleen ifi SchoolLecturer
+  void . insert' $ UserFunction fhamann ifi SchoolLecturer
+  void . insert' $ UserFunction jost ifi SchoolLecturer
+  void . insert' $ UserFunction svaupel ifi SchoolLecturer
  let
    sdBsc = StudyDegreeKey' 82
    sdMst = StudyDegreeKey' 88
--- a/test/FoundationSpec.hs
+++ b/test/FoundationSpec.hs
@ -23,6 +23,10 @@ instance Arbitrary (Route EmbeddedStatic) where
    paramNum <- getNonNegative <$> arbitrary
    params <- replicateM paramNum $ (,) <$> printableText <*> printableText
    return $ embeddedResourceR path params
+  
+instance Arbitrary SchoolR where
+  arbitrary = genericArbitrary
+  shrink = genericShrink

 instance Arbitrary CourseR where
  arbitrary = genericArbitrary
--- a/test/Handler/Utils/SchoolLdapSpec.hs
+++ b/test/Handler/Utils/SchoolLdapSpec.hs
@ -0,0 +1,18 @@
+module Handler.Utils.SchoolLdapSpec where
+
+import TestImport
+
+import Handler.Utils.SchoolLdap
+
+import qualified Data.Set as Set
+
+spec :: Spec
+spec = describe "ldap school extraction" $ do
+  it "works for some examples" . example $ do
+    let matches str frags = parseLdapSchools str `shouldBe` Right (Set.fromList frags)
+
+    "ou=Fakultät für Mathematik, Informatik und Statistik (16_Fak_Mathe_Info_Stat),o=uni-muenchen,c=de" `matches` ["Fakultät für Mathematik, Informatik und Statistik (16_Fak_Mathe_Info_Stat)", "uni-muenchen", "de"]
+    "ou=Katholisch-Theologische Fakultät (01 Fak. Kathol. Theologie),o=uni-muenchen,c=de" `matches` ["Katholisch-Theologische Fakultät (01 Fak. Kathol. Theologie)", "uni-muenchen", "de"]
+    "ou=C4-Professur für Informatik (1603 C4 Hofmann),ou=Department Institut für Informatik (1603 Dept. Informatik),ou=Fakultät für Mathematik, Informatik und Statistik (16 Fak. Mathe Info. Stat.),o=uni-muenchen,c=de" `matches` ["C4-Professur für Informatik (1603 C4 Hofmann)", "Department Institut für Informatik (1603 Dept. Informatik)", "Fakultät für Mathematik, Informatik und Statistik (16 Fak. Mathe Info. Stat.)", "uni-muenchen", "de"]
+    "ou=Department Mathematisches Institut (1601_Dept_Mathemat_Inst),ou=Fakultät für Mathematik, Informatik und Statistik (16_Fak_Mathe_Info_Stat),o=uni-muenchen,c=de" `matches` ["Department Mathematisches Institut (1601_Dept_Mathemat_Inst)", "Fakultät für Mathematik, Informatik und Statistik (16_Fak_Mathe_Info_Stat)", "uni-muenchen", "de"]
+    "ou=Fakultät für Physik (17_Fakultät_Physik),o=uni-muenchen,c=de" `matches` ["Fakultät für Physik (17_Fakultät_Physik)", "uni-muenchen", "de"]
--- a/test/ModelSpec.hs
+++ b/test/ModelSpec.hs
@ -102,6 +102,9 @@ instance Arbitrary User where
    userMailLanguages <- arbitrary
    userNotificationSettings <- arbitrary

+    userCreated <- arbitrary
+    userLastLdapSynchronisation <- arbitrary
+
    return User{..}
  shrink = genericShrink

--- a/test/TestImport.hs
+++ b/test/TestImport.hs
@ -108,6 +108,7 @@ authenticateAs (Entity _ User{..}) = do
 createUser :: (User -> User) -> YesodExample UniWorX (Entity User)
 createUser adjUser = do
  UserDefaultConf{..} <- appUserDefaults . view appSettings <$> getTestYesod
+  now <- liftIO getCurrentTime
  let
    userMatrikelnummer = Nothing
    userAuthentication = AuthLDAP
@ -128,6 +129,8 @@ createUser adjUser = do
    userWarningDays = userDefaultWarningDays
    userMailLanguages = def
    userNotificationSettings = def
+    userCreated = now
+    userLastLdapSynchronisation = Nothing
  runDB . insertEntity $ adjUser User{..}

 lawsCheckHspec :: Typeable a => Proxy a -> [Proxy a -> Laws] -> Spec