chore: merge master

.gitlab-ci.yml

@@ -0,0 +1,234 @@
+default:
+  image:
+    name: fpco/stack-build:lts-13.21
+  cache:
+    paths:
+      - node_modules
+      - .stack
+      - .stack-work
+      
+variables:
+  STACK_ROOT: "${CI_PROJECT_DIR}/.stack"
+  CHROME_BIN: "/usr/bin/chromium-browser"
+  POSTGRES_DB: uniworx_test
+  POSTGRES_USER: uniworx
+  POSTGRES_PASSWORD: uniworx
+
+stages:
+  - setup
+  - frontend:build
+  - yesod:build
+  - lint
+  - test
+  - deploy
+  
+npm install:
+  stage: setup
+  script:
+    - npm install
+  before_script: &npm
+    - apt-get update -y
+    - npm install -g n
+    - n stable
+    - npm install -g npm
+    - hash -r
+  artifacts:
+    paths:
+      - node_modules/
+    name: "${CI_JOB_NAME}"
+    expire_in: "1 day"
+  retry: 2
+  
+frontend:build:
+  stage: frontend:build
+  script:
+    - npm run frontend:build
+  before_script: *npm
+  needs:
+    - npm install
+  artifacts:
+    paths:
+      - static/bundles/
+    name: "${CI_JOB_NAME}"
+    expire_in: "1 day"
+  dependencies:
+    - npm install
+  retry: 2
+
+frontend:lint:
+  stage: lint
+  script:
+    - npm run frontend:lint
+  before_script: *npm
+  needs:
+    - npm install
+  dependencies:
+    - npm install
+  retry: 2
+
+yesod:build:dev:
+  stage: yesod:build
+  script:
+    - stack build --copy-bins --local-bin-path $(pwd)/bin --fast --flag uniworx:-library-only --flag uniworx:dev --flag uniworx:pedantic
+  needs:
+    - frontend:build
+  before_script:
+    - apt-get update -y
+    - apt-get install -y --no-install-recommends locales-all
+    - ln -s $(which g++-7) $(dirname $(which g++-7))/g++
+  artifacts:
+    paths:
+      - bin/
+    name: "${CI_JOB_NAME}"
+    expire_in: "1 week"
+  dependencies:
+    - frontend:build
+
+  only:
+    variables:
+      - $CI_COMMIT_REF_NAME !~ /^v[0-9].*/
+  retry: 2
+    
+yesod:build:
+  stage: yesod:build
+  script:
+    - stack build --copy-bins --local-bin-path $(pwd)/bin --flag uniworx:-library-only --flag uniworx:-dev --flag uniworx:pedantic
+  needs:
+    - frontend:build
+  before_script:
+    - apt-get update -y
+    - apt-get install -y --no-install-recommends locales-all
+    - ln -s $(which g++-7) $(dirname $(which g++-7))/g++
+  artifacts:
+    paths:
+      - bin/
+    name: "${CI_JOB_NAME}"
+  dependencies:
+    - frontend:build
+    
+  only:
+    variables:
+      - $CI_COMMIT_REF_NAME =~ /^v[0-9].*/
+  retry: 2
+
+frontend:test:
+  stage: test
+  script:
+    - npm run frontend:test
+  needs:
+    - npm install
+  before_script:
+    - apt-get update -y
+    - npm install -g n
+    - n stable
+    - npm install -g npm
+    - hash -r
+    - apt-get install -y --no-install-recommends chromium-browser
+  dependencies:
+    - npm install
+  retry: 2
+
+hlint:dev:
+  stage: lint
+  script:
+    - stack test --fast --flag uniworx:-library-only --flag uniworx:dev --flag uniworx:pedantic uniworx:test:hlint
+  needs:
+    - frontend:build
+    - yesod:build:dev # For caching
+  before_script:
+    - apt-get update -y
+    - apt-get install -y --no-install-recommends locales-all
+    - ln -s $(which g++-7) $(dirname $(which g++-7))/g++
+  dependencies:
+    - frontend:build
+
+  only:
+    variables:
+      - $CI_COMMIT_REF_NAME !~ /^v[0-9].*/
+  retry: 2
+
+yesod:test:dev:
+  services:
+    - name: postgres:10.10
+      alias: postgres
+
+  stage: test
+  script:
+    - stack test --coverage --fast --flag uniworx:-library-only --flag uniworx:dev --flag uniworx:pedantic --skip hlint
+  needs:
+    - frontend:build
+    - yesod:build:dev # For caching
+  before_script:
+    - apt-get update -y
+    - apt-get install -y --no-install-recommends locales-all
+    - ln -s $(which g++-7) $(dirname $(which g++-7))/g++
+  dependencies:
+    - frontend:build
+      
+  only:
+    variables:
+      - $CI_COMMIT_REF_NAME !~ /^v[0-9].*/
+  retry: 2
+
+hlint:
+  stage: lint
+  script:
+    - stack test --flag uniworx:-library-only --flag uniworx:-dev --flag uniworx:pedantic uniworx:test:hlint
+  needs:
+    - frontend:build
+    - yesod:build # For caching
+  before_script:
+    - apt-get update -y
+    - apt-get install -y --no-install-recommends locales-all
+    - ln -s $(which g++-7) $(dirname $(which g++-7))/g++
+  dependencies:
+    - frontend:build
+
+  only:
+    variables:
+      - $CI_COMMIT_REF_NAME =~ /^v[0-9].*/
+  retry: 2
+
+yesod:test:
+  services:
+    - name: postgres:10.10
+      alias: postgres
+
+  stage: test
+  script:
+    - stack test --coverage --flag uniworx:-library-only --flag uniworx:-dev --flag uniworx:pedantic --skip hlint
+  needs:
+    - frontend:build
+    - yesod:build # For caching
+  before_script:
+    - apt-get update -y
+    - apt-get install -y --no-install-recommends locales-all
+    - ln -s $(which g++-7) $(dirname $(which g++-7))/g++
+  dependencies:
+    - frontend:build
+      
+  only:
+    variables:
+      - $CI_COMMIT_REF_NAME =~ /^v[0-9].*/
+  retry: 2
+
+deploy:uniworx3:
+  stage: deploy
+  script:
+    - ssh -i ~/.ssh/id root@uniworx3.ifi.lmu.de <bin/uniworx
+  needs:
+    - yesod:build
+    - yesod:test # For sanity
+    - hlint # For sanity
+  before_script:
+    - apt-get update -y
+    - apt-get install -y --no-install-recommends openssh-client
+    - install -m 0700 -d ~/.ssh
+    - install -m 0644 ${SSH_KNOWN_HOSTS} ~/.ssh/known_hosts
+    - install -m 0400 ${SSH_PRIVATE_KEY_UNIWORX3} ~/.ssh/id
+  dependencies:
+    - yesod:build
+        
+  only:
+    variables:
+      - $CI_COMMIT_REF_NAME =~ /^v[0-9].*/

clean.sh

@@ -4,39 +4,39 @@ set -e
 
 [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || :
 
-case $1 in
+if [[ -n "${1}" ]]; then
-    "")
+    target=".stack-work-${1}"
-        exec -- stack clean
+else
-        ;;
+    target=".stack-work"
-    *)
+fi
-        target=".stack-work-${1}"
+shift
-        shift
 
-        if [[ ! -d "${target}" ]]; then
+if [[ ! -d "${target}" ]]; then
-            printf "%s does not exist or is no directory\n" "${target}" >&2
+    printf "%s does not exist or is no directory\n" "${target}" >&2
-            exit 1
+    exit 1
-        fi
+fi
-        if [[ -e .stack-work-clean ]]; then
-            printf ".stack-work-clean exists\n" >&2
-            exit 1
-        fi
 
-        move-back() {
+if [[ "${target}" != ".stack-work" ]]; then
-            if [[ -d .stack-work ]]; then
+  if [[ -e .stack-work-clean ]]; then
-                mv -v .stack-work "${target}"
+      printf ".stack-work-clean exists\n" >&2
-            else
+      exit 1
-                mkdir -v "${target}"
+  fi
-            fi
-            [[ -d .stack-work-clean ]] && mv -v .stack-work-clean .stack-work
-        }
 
-        mv -v .stack-work .stack-work-clean
+  move-back() {
-        mv -v "${target}" .stack-work
+      if [[ -d .stack-work ]]; then
-        trap move-back EXIT
+          mv -v .stack-work "${target}"
+      else
+          mkdir -v "${target}"
+      fi
+      [[ -d .stack-work-clean ]] && mv -v .stack-work-clean .stack-work
+  }
 
-        (
+  mv -v .stack-work .stack-work-clean
-            set -ex
+  mv -v "${target}" .stack-work
-            stack clean $@
+  trap move-back EXIT
-        )
+fi
-        ;;
+
-esac
+(
+    set -ex
+    stack clean $@
+)

config/settings.yml

@@ -30,6 +30,8 @@ session-timeout: 7200
 jwt-expiration: 604800
 jwt-encoding: HS256
 maximum-content-length: "_env:MAX_UPLOAD_SIZE:134217728"
+session-files-expire: 3600
+prune-unreferenced-files: 86400
 health-check-interval:
   matching-cluster-config: "_env:HEALTHCHECK_INTERVAL_MATCHING_CLUSTER_CONFIG:600"
   http-reachable: "_env:HEALTHCHECK_INTERVAL_HTTP_REACHABLE:600"

frontend/src/services/i18n/i18n.js

@@ -1,3 +1,5 @@
+import moment from 'moment';
+
   /**
    * I18n
    *
@@ -13,10 +15,15 @@
 
 export class I18n {
 
-  translations = {};
+  _translations = {};
+  _datetimeLocale = undefined;
 
   add(id, translation) {
-    this.translations[id] = translation;
+    if (!this._translations[id]) {
+      this._translations[id] = translation;
+    } else {
+      throw new Error('I18N Error: Attempting to set translation multiple times for »' + id + '«!');
+    }
   }
 
   addMany(manyTranslations) {
@@ -24,9 +31,27 @@ export class I18n {
   }
 
   get(id) {
-    if (!this.translations[id]) {
+    if (!this._translations[id]) {
       throw new Error('I18N Error: Translation missing for »' + id + '«!');
     }
-    return this.translations[id];
+    return this._translations[id];
+  }
+
+
+  setDatetimeLocale(locale) {
+    if (!this._datetimeLocale) {
+      moment.locale(locale);
+      this._datetimeLocale = locale;
+    } else {
+      throw new Error('I18N Error: Attempting to set datetime locale multiple times!');
+    }
+  }
+
+  getDatetimeLocale() {
+    if (!this._datetimeLocale) {
+      throw new Error('I18N Error: Attempting to access datetime locale when it has not been set!');
+    }
+    
+    return this._datetimeLocale;
   }
 }

frontend/src/services/i18n/i18n.spec.js

@@ -9,7 +9,7 @@ describe('I18n', () => {
 
   // helper function
   function expectTranslation(id, value) {
-    expect(i18n.translations[id]).toMatch(value);
+    expect(i18n.get(id)).toMatch(value);
   }
 
   it('should create', () => {
@@ -38,7 +38,7 @@ describe('I18n', () => {
 
   describe('get()', () => {
     it('should return stored translations', () => {
-      i18n.translations.id1 = 'something';
+      i18n.add('id1', 'something');
       expect(i18n.get('id1')).toMatch('something');
     });
 

frontend/src/utils/form/datepicker.js

@@ -48,9 +48,6 @@ const DATEPICKER_CONFIG = {
     timeMinutes: 0,
     timeSeconds: 0,
 
-    // german settings
-    // TODO: hardcoded, get from current language / settings
-    locale: 'de',
     weekStart: 1,
     dateFormat: FORM_DATE_FORMAT_DATE_DT,
     timeFormat: FORM_DATE_FORMAT_TIME_DT,
@@ -86,6 +83,7 @@ export class Datepicker {
   datepickerInstance;
   _element;
   elementType;
+  _locale;
 
   constructor(element) {
     if (!element) {
@@ -96,6 +94,8 @@ export class Datepicker {
       return false;
     }
 
+    this._locale = window.App.i18n.getDatetimeLocale();
+
     // initialize datepickerCollections singleton if not already done
     if (!Datepicker.datepickerCollections) {
       Datepicker.datepickerCollections = new Map();
@@ -134,7 +134,7 @@ export class Datepicker {
     }
 
     // initialize tail.datetime (datepicker) instance and let it do weird stuff with the element value
-    this.datepickerInstance = datetime(this._element, { ...datepickerGlobalConfig, ...datepickerConfig });
+    this.datepickerInstance = datetime(this._element, { ...datepickerGlobalConfig, ...datepickerConfig, locale: this._locale });
 
     // reset date to something sane
     if (parsedMomentDate)
@@ -180,14 +180,27 @@ export class Datepicker {
     // change the selected date in the tail.datetime instance if the value of the input element is changed
     this._element.addEventListener('change', setDatepickerDate, { once: true });
 
-    // close the instance if something other than the instance was clicked (i.e. if the target is not within the datepicker instance and if any previously clicked calendar view was replaced (is not in the window anymore) because it was clicked). YES, I KNOW
+    // close the instance on focusout of any element if another input is focussed that is neither the timepicker nor _element
-    window.addEventListener('click', event => {
+    window.addEventListener('focusout', event => {
-      if (!this.datepickerInstance.dt.contains(event.target) && window.document.contains(event.target)) {
+      const hasFocus                = event.relatedTarget !== null;
+      const focussedIsNotTimepicker = !this.datepickerInstance.dt.contains(event.relatedTarget);
+      const focussedIsNotElement    = event.relatedTarget !== this._element;
+      const focussedIsInDocument    = window.document.contains(event.relatedTarget);
+      if (hasFocus && focussedIsNotTimepicker && focussedIsNotElement && focussedIsInDocument)
+        this.datepickerInstance.close();
+    });
+    
+    // close the instance on click on any element outside of the datepicker (except the input element itself)
+    window.addEventListener('click', event => {
+      const targetIsOutside    = !this.datepickerInstance.dt.contains(event.target)
+                                 && event.target !== this.datepickerInstance.dt;
+      const targetIsInDocument = window.document.contains(event.target);
+      const targetIsNotElement = event.target !== this._element;
+      if (targetIsOutside && targetIsInDocument && targetIsNotElement)
         this.datepickerInstance.close();
-      }
     });
 
-    // close the datepicker on escape keydown events
+    // close the instance on escape keydown events
     this._element.addEventListener('keydown', event => {
       if (event.keyCode === KEYCODE_ESCAPE) {
         this.datepickerInstance.close();

frontend/src/utils/inputs/checkbox.js

@@ -5,7 +5,7 @@ var CHECKBOX_CLASS = 'checkbox';
 var CHECKBOX_INITIALIZED_CLASS = 'checkbox--initialized';
 
 @Utility({
-  selector: 'input[type="checkbox"]',
+  selector: 'input[type="checkbox"]:not([uw-no-checkbox])',
 })
 export class Checkbox {
 

frontend/src/utils/inputs/checkbox.scss

@@ -1,19 +1,20 @@
 
 /* CUSTOM CHECKBOXES */
 /* Completely replaces legacy checkbox */
+.checkbox [type='checkbox'], #lang-checkbox {
+  position: fixed;
+  top: -1px;
+  left: -1px;
+  width: 1px;
+  height: 1px;
+  overflow: hidden;
+  display: none;
+}
+
 .checkbox {
   position: relative;
   display: inline-block;
 
-  [type='checkbox'] {
-    position: fixed;
-    top: -1px;
-    left: -1px;
-    width: 1px;
-    height: 1px;
-    overflow: hidden;
-  }
-
   label {
     display: block;
     height: 20px;

frontend/src/utils/inputs/inputs.scss

@@ -150,7 +150,6 @@ textarea {
   padding: 4px 13px;
   font-size: 1rem;
   font-family: var(--font-base);
-  -webkit-appearance: none;
   appearance: none;
   border: 1px solid #dbdbdb;
   border-radius: 2px;
@@ -184,8 +183,8 @@ textarea {
 
 /* OPTIONS */
 
-select {
+select[size = "1"], select:not([size]) {
-  -webkit-appearance: menulist;
+  appearance: menulist;
 }
 
 select,

frontend/src/utils/navbar/navbar.js

@@ -0,0 +1,48 @@
+import { Utility } from '../../core/utility';
+import './navbar.scss';
+
+
+export const LANGUAGE_SELECT_UTIL_SELECTOR = '[uw-language-select]';
+const LANGUAGE_SELECT_INITIALIZED_CLASS = 'language-select--initialized';
+
+
+@Utility({
+  selector: LANGUAGE_SELECT_UTIL_SELECTOR,
+})
+export class LanguageSelectUtil {
+  _element;
+  checkbox;
+  
+  constructor(element) {
+    if (!element) {
+      throw new Error('Language Select utility needs to be passed an element!');
+    }
+
+    if (element.classList.contains(LANGUAGE_SELECT_INITIALIZED_CLASS)) {
+      return false;
+    }
+
+    this._element = element;
+    this.checkbox = element.querySelector('#lang-checkbox');
+
+    window.addEventListener('click', event => this.close(event));
+
+    element.classList.add(LANGUAGE_SELECT_INITIALIZED_CLASS);
+  }
+
+  close(event) {
+    if (!this._element.contains(event.target) && window.document.contains(event.target)) {
+      this.checkbox.checked = false;
+    }
+  }
+
+  destroy() {
+    // TODO
+  }
+
+}
+
+
+export const NavbarUtils = [
+  LanguageSelectUtil,
+];

frontend/src/utils/navbar/navbar.scss

@@ -68,14 +68,7 @@
   color: var(--color-lightwhite);
   transition: height .2s cubic-bezier(0.03, 0.43, 0.58, 1);
   overflow: hidden;
-
+  cursor: pointer;
-  &:hover {
-    color: var(--color-lightwhite);
-
-    .navbar__link-icon {
-      opacity: 1;
-    }
-  }
 }
 
 .navbar__link-icon {
@@ -88,6 +81,7 @@
   transition: opacity .2s ease;
   padding: 2px 4px;
   text-transform: uppercase;
+  font-weight: 600;
 }
 
 @media (min-width: 769px) {
@@ -146,7 +140,9 @@
 .navbar__list-item {
   position: relative;
   transition: background-color .1s ease;
-
+  &:not(.navbar__list-item--favorite) + .navbar__list-item--lang-wrapper {
+    margin-left: 12px;
+  }
   &:not(.navbar__list-item--favorite) + .navbar__list-item {
     margin-left: 12px;
   }
@@ -160,6 +156,9 @@
     &:not(.navbar__list-item--favorite) + .navbar__list-item {
       margin-left: 0;
     }
+    &:not(.navbar__list-item--favorite) + .navbar__list-item--lang-wrapper {
+      margin-left: 0;
+    }
   }
 }
 
@@ -219,9 +218,13 @@
   color: var(--color-dark);
 }
 
-.navbar .navbar__list-item:not(.navbar__list-item--active):not(.navbar__list-item--favorite):hover .navbar__link-wrapper {
+.navbar .navbar__list-item:not(.navbar__list-item--active):not(.navbar__list-item--favorite):hover .navbar__link-wrapper, #lang-checkbox:checked ~ * .navbar__link-wrapper {
   background-color: var(--color-dark);
   color: var(--color-lightwhite);
+
+  .navbar__link-icon {
+    opacity: 1;
+  }
 }
 
 /* sticky state */
@@ -267,3 +270,36 @@
     height: var(--header-height-collapsed);
   }
 }
+
+
+#lang-dropdown {
+    display: none;
+
+    position: fixed;
+    top: var(--header-height);
+    right: 0;
+    min-width: 200px;
+    z-index: 10;
+    background-color: white;
+    border-radius: 2px;
+    box-shadow: 0 0 10px rgba(0,0,0,0.3);
+
+    select {
+      display: block;
+    }
+
+    button {
+      display: block;
+      width: 100%;
+    }
+}
+
+#lang-checkbox:checked ~ #lang-dropdown {
+  display: block;
+}
+
+@media (max-width: 768px) {
+    #lang-dropdown {
+      top: var(--header-height-collapsed);
+    }
+}

frontend/src/utils/utils.js

@@ -10,6 +10,7 @@ import { MassInput } from './mass-input/mass-input';
 import { Modal } from './modal/modal';
 import { Tooltip } from './tooltips/tooltips';
 import { CourseTeaser } from './course-teaser/course-teaser';
+import { NavbarUtils } from './navbar/navbar';
 
 export const Utils = [
   Alerts,
@@ -25,4 +26,5 @@ export const Utils = [
   ShowHide,
   Tooltip,
   CourseTeaser,
+  ...NavbarUtils,
 ];

messages/button/en.msg

@@ -0,0 +1,3 @@
+AmbiguousButtons: Multiple active submit buttons
+WrongButtonValue: Submit button has wrong value
+MultipleButtonValues: Submit button has multiple values

messages/campus/de.msg

@@ -1,5 +1,6 @@
 CampusIdentPlaceholder: Vorname.Nachname@campus.lmu.de
 CampusIdent: Campus-Kennung
 CampusPassword: Passwort
+CampusPasswordPlaceholder: Passwort
 CampusSubmit: Abschicken
 CampusInvalidCredentials: Ungültige Logindaten

messages/campus/en.msg

@@ -0,0 +1,6 @@
+CampusIdentPlaceholder: First.Last@campus.lmu.de
+CampusIdent: Campus account
+CampusPassword: Password
+CampusPasswordPlaceholder: Password
+CampusSubmit: Send
+CampusInvalidCredentials: Invalid login

messages/dummy/de.msg

@@ -1,2 +1,3 @@
-DummyIdent: Nutzer-Kennung
+DummyIdent: Identifikation
+DummyIdentPlaceholder: Identifikation
 DummyNoFormData: Keine Formulardaten empfangen

messages/dummy/en.msg

@@ -0,0 +1,3 @@
+DummyIdent: Identification
+DummyIdentPlaceholder: Identification
+DummyNoFormData: No form data received

messages/frontend/de-de-formal.msg

@@ -1,4 +1,4 @@
 FilesSelected: Dateien ausgewählt
 SelectFile: Datei auswählen
 SelectFiles: Datei(en) auswählen
-AsyncFormFailure: Da ist etwas schief gelaufen, das tut uns Leid. Falls das erneut passiert schicke uns gerne eine kurze Beschreibung dieses Ereignisses über das Hilfe-Widget rechts oben. Vielen Dank für deine Hilfe!
+AsyncFormFailure: Da ist etwas schief gelaufen, das tut uns Leid. Falls das erneut passiert schicken Sie uns bitte eine kurze Beschreibung dieses Ereignisses über das Hilfe-Widget rechts oben. Vielen Dank für Ihre Hilfe!

messages/frontend/en.msg

@@ -0,0 +1,4 @@
+FilesSelected: Files selected
+SelectFile: Select file
+SelectFiles: Select file(s)
+AsyncFormFailure: Something went wrong, we are sorry. If this error occurs again, please let us know by clicking the Support button in the upper right corner. Thank you very much!

messages/pw-hash/de.msg

@@ -1,2 +1,4 @@
 PWHashIdent: Identifikation
-PWHashPassword: Passwort
+PWHashIdentPlaceholder: Identifikation
+PWHashPassword: Passwort
+PWHashPasswordPlaceholder: Passwort

messages/pw-hash/en.msg

@@ -0,0 +1,4 @@
+PWHashIdent: Identification
+PWHashIdentPlaceholder: Identification
+PWHashPassword: Password
+PWHashPasswordPlaceholder: Password

messages/uniworx/de-de-formal.msg

@@ -1,5 +1,7 @@
 PrintDebugForStupid name@Text: Debug message "#{name}"
 
+Logo: Uni2work
+
 BtnSubmit: Senden
 BtnAbort: Abbrechen
 BtnDelete: Löschen
@@ -71,9 +73,9 @@ Term: Semester
 TermPlaceholder: W/S + vierstellige Jahreszahl
 
 TermStartDay: Erster Tag
-TermStartDayTooltip: Üblicherweise immer 1.April oder 1.Oktober
+TermStartDayTooltip: Üblicherweise immer 1. April oder 1. Oktober
 TermEndDay: Letzter Tag
-TermEndDayTooltip: Üblicherweise immer 30.September oder 31.März
+TermEndDayTooltip: Üblicherweise immer 30. September oder 31. März
 TermHolidays: Feiertage
 TermHolidayPlaceholder: Feiertag
 TermLectureStart: Beginn Vorlesungen
@@ -98,6 +100,7 @@ CourseRegistration: Kursanmeldung
 CourseRegisterOpen: Anmeldung möglich
 CourseRegisterOk: Erfolgreich zum Kurs angemeldet
 CourseDeregisterOk: Erfolgreich vom Kurs abgemeldet
+CourseApply: Zum Kurs bewerben
 CourseApplyOk: Erfolgreich zum Kurs beworben
 CourseRetractApplyOk: Bewerbung zum Kurs erfolgreich zurückgezogen
 CourseDeregisterLecturerTip: Wenn Sie den Teilnehmer vom Kurs abmelden kann es sein, dass sie Zugriff auf diese Daten verlieren
@@ -109,8 +112,8 @@ CourseTutorial: Tutorium
 CourseSecretWrong: Falsches Passwort
 CourseSecret: Zugangspasswort
 CourseEditOk       tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} wurde erfolgreich geändert.
-CourseNewDupShort  tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester.
+CourseNewDupShort  tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester und Institut.
-CourseEditDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester.
+CourseEditDupShort tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{csh} in diesem Semester und Institut.
 FFSheetName: Name
 TermCourseListHeading tid@TermId: Kursübersicht #{tid}
 TermSchoolCourseListHeading tid@TermId school@SchoolName: Kursübersicht #{tid} für #{school}
@@ -128,7 +131,7 @@ CourseMembersCountLimited n@Int max@Int: #{n}/#{max}
 CourseMembersCountOf n@Int mbNum@IntMaybe: #{n} Kursanmeldungen #{maybeToMessage " von " mbNum " möglichen"}
 CourseName: Name
 CourseDescription: Beschreibung
-CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet
+CourseDescriptionTip: Beliebiges Html-Markup ist gestattet
 CourseHomepageExternal: Externe Homepage
 CourseShorthand: Kürzel
 CourseShorthandUnique: Muss nur innerhalb Institut und Semester eindeutig sein. Wird verbatim in die Url der Kursseite übernommen.
@@ -142,14 +145,16 @@ CourseRegisterToTip: Darf auch unbegrenzt offen bleiben
 CourseDeregisterUntilTip: Abmeldung ist ab "Anmeldungen von" bis zu diesem Zeitpunkt erlaubt. Die Abmeldung darf auch unbegrenzt erlaubt bleiben.
 CourseFilterSearch: Volltext-Suche
 CourseFilterRegistered: Registriert
-CourseFilterNone: Egal
+CourseFilterNone: —
+BoolIrrelevant: —
 CourseDeleteQuestion: Wollen Sie den unten aufgeführten Kurs wirklich löschen?
 CourseDeleted: Kurs gelöscht
 CourseUserTutorials: Angemeldete Tutorien
 CourseUserNote: Notiz
-CourseUserNoteTooltip: Nur für Dozenten dieses Kurses einsehbar
+CourseUserNoteTooltip: Nur für Verwalter dieses Kurses einsehbar
 CourseUserNoteSaved: Notizänderungen gespeichert
 CourseUserNoteDeleted: Teilnehmernotiz gelöscht
+CourseUserRegister: Zum Kurs anmelden
 CourseUserDeregister: Vom Kurs abmelden
 CourseUsersDeregistered count@Int64: #{show count} Teilnehmer vom Kurs abgemeldet
 CourseUserRegisterTutorial: Zu einem Tutorium anmelden
@@ -184,7 +189,7 @@ CourseApplication: Bewerbung
 CourseApplicationIsParticipant: Kursteilnehmer
 
 CourseApplicationExists: Sie haben sich bereits für diesen Kurs beworben
-CourseApplicationInvalidAction: Angegeben Aktion kann nicht durchgeführt werden
+CourseApplicationInvalidAction: Angegebene Aktion kann nicht durchgeführt werden
 CourseApplicationCreated csh@CourseShorthand: Erfolgreich zu #{csh} beworben
 CourseApplicationEdited csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich angepasst
 CourseApplicationNotEdited csh@CourseShorthand: Bewerbung zu #{csh} hat sich nicht verändert
@@ -271,6 +276,8 @@ SheetSubmissionMode: Abgabe-Modus
 SheetExercise: Aufgabenstellung
 SheetHint: Hinweis
 SheetHintFrom: Hinweis ab
+SheetHintFromPlaceholder: Datum, sonst nur für Korrektoren
+SheetSolutionFromPlaceholder: Datum, sonst nur für Korrektoren
 SheetSolution: Lösung
 SheetSolutionFrom: Lösung ab
 SheetMarking: Hinweise für Korrektoren
@@ -282,9 +289,15 @@ SheetDescription: Hinweise für Teilnehmer
 SheetGroup: Gruppenabgabe
 SheetVisibleFrom: Sichtbar für Teilnehmer ab
 SheetVisibleFromTip: Ohne Datum nie sichtbar und keine Abgabe möglich; nur für unfertige Blätter leer lassen, deren Bewertung/Fristen sich noch ändern können
-SheetActiveFrom: Beginn Abgabezeitraum
+SheetActiveFrom: Aktiv ab/Beginn Abgabezeitraum
-SheetActiveFromTip: Download der Aufgabenstellung erst ab diesem Datum möglich
+SheetActiveFromParticipant: Beginn Abgabezeitraum
-SheetActiveTo: Ende Abgabezeitraum
+SheetActiveFromParticipantNoSubmit: Herausgabe der Aufgabestellung
+SheetActiveFromTip: Download der Aufgabenstellung und Abgabe erst ab diesem Datum möglich. Ohne Datum keine Abgabe und keine Herausgabe der Aufgabenstellung
+SheetActiveFromUnset: Nie
+SheetActiveTo: Aktiv bis/Ende Abgabezeitraum
+SheetActiveToParticipant: Ende Abgabezeitraum
+SheetActiveToTip: Abgabe nur bis zu diesem Datum möglich. Ohne Datum unbeschränkte Abgabe möglich (soweit gefordert).
+SheetActiveToUnset: Nie
 SheetHintFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen
 SheetSolutionFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen
 SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren
@@ -315,6 +328,7 @@ SubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetNa
 CorrectionHead     tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName cid@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{sheetName}: Korrektur
 SubmissionMembers: Abgebende
 SubmissionMember: Abgebende(r)
+CosubmittorTip: Einladungen per E-Mail erhalten genau jene Adressen, für die nicht gesichert werden kann, dass sie mit der dahinter stehenden Person schon einmal für diesen Kurs abgegeben haben. Wenn eine angegebene Adresse einer Person zugeordnet werden kann, mit der Sie in diesem Kurs schon einmal zusammen abgegeben haben, wird der Name der Person angezeigt und die Abgabe erfolgt sofort auch im Namen jener Person.
 SubmissionArchive: Zip-Archiv der Abgabedatei(en)
 SubmissionFile: Datei zur Abgabe
 SubmissionFiles: Abgegebene Dateien
@@ -333,6 +347,8 @@ CourseCorrectionsTitle: Korrekturen für diesen Kurs
 CorrectorsHead sheetName@SheetName: Korrektoren für #{sheetName}
 CorrectorAssignTitle: Korrektor zuweisen
 
+CorrectionsGrade: Abgaben online korrigieren
+
 MaterialName: Name
 MaterialType: Art
 MaterialTypePlaceholder: Folien, Code, Beispiel, ...
@@ -370,6 +386,8 @@ UnauthorizedTokenNotStarted: Ihr Authorisierungs-Token ist noch nicht gültig.
 UnauthorizedTokenInvalid: Ihr Authorisierungs-Token konnte nicht verarbeitet werden.
 UnauthorizedTokenInvalidRoute: Ihr Authorisierungs-Token ist auf dieser Unterseite nicht gültig.
 UnauthorizedTokenInvalidAuthority: Ihr Authorisierungs-Token basiert auf den Rechten eines Nutzers, der nicht mehr existiert.
+UnauthorizedTokenInvalidAuthorityGroup: Ihr Authorisierungs-Token basiert auf den Rechten einer Gruppe von Nutzern, die nicht mehr existiert.
+UnauthorizedTokenInvalidAuthorityValue: Ihr Authorisierungs-Token basiert auf Rechten, deren Spezifikation nicht interpretiert werden konnte.
 UnauthorizedToken404: Authorisierungs-Tokens können nicht auf Fehlerseiten ausgewertet werden.
 UnauthorizedSiteAdmin: Sie sind kein System-weiter Administrator.
 UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen.
@@ -478,7 +496,7 @@ HomeOpenAllocations: Offene Zentralanmeldungen
 HomeUpcomingSheets: Anstehende Übungsblätter
 HomeUpcomingExams: Bevorstehende Prüfungen
 
-NumCourses num@Int64: #{num} Kurse
+NumCourses num@Int64: #{num} #{pluralDE num "Kurs" "Kurse"}
 CloseAlert: Schliessen
 
 Name: Name
@@ -519,15 +537,15 @@ NatField name@Text: #{name} muss eine natürliche Zahl sein!
 JSONFieldDecodeFailure aesonFailure@String: Konnte JSON nicht parsen: #{aesonFailure}
 SecretJSONFieldDecryptFailure: Konnte versteckte vertrauliche Daten nicht entschlüsseln
 
-SubmissionsAlreadyAssigned num@Int64: #{num} Abgaben waren bereits einem Korrektor zugeteilt und wurden nicht verändert:
+SubmissionsAlreadyAssigned num@Int64: #{num} #{pluralDE num "Abgabe" "Abgaben"} waren bereits einem Korrektor zugeteilt und wurden nicht verändert:
-SubmissionsAssignUnauthorized num@Int64: #{num} Abgaben können momentan nicht einem Korrektor zugeteilt werden (z.B. weil die Abgabe noch offen ist):
+SubmissionsAssignUnauthorized num@Int64: #{num} #{pluralDE num "Abgabe" "Abgaben"} können momentan nicht einem Korrektor zugeteilt werden (z.B. weil die Abgabe noch offen ist):
-UpdatedAssignedCorrectorSingle num@Int64: #{num} Abgaben wurden dem neuen Korrektor zugeteilt.
+UpdatedAssignedCorrectorSingle num@Int64: #{num} #{pluralDE num "Abgabe" "Abgaben"} wurden dem neuen Korrektor zugeteilt.
 NoCorrector: Kein Korrektor
-RemovedCorrections num@Int64: Korrektur-Daten wurden von #{num} Abgaben entfernt.
+RemovedCorrections num@Int64: Korrektur-Daten wurden von #{num} #{pluralDE num "Abgabe" "Abgaben"} entfernt.
-UpdatedAssignedCorrectorsAuto num@Int64: #{num} Abgaben wurden unter den Korrektoren aufgeteilt.
+UpdatedAssignedCorrectorsAuto num@Int64: #{num} #{pluralDE num "Abgabe" "Abgaben"} wurden unter den Korrektoren aufgeteilt.
 UpdatedSheetCorrectorsAutoAssigned n@Int: #{n} #{pluralDE n "Abgabe wurde einem Korrektor" "Abgaben wurden Korrektoren"} zugteilt.
 UpdatedSheetCorrectorsAutoFailed n@Int: #{n} #{pluralDE n "Abgabe konnte" "Abgaben konnten"} nicht automatisch zugewiesen werden.
-CouldNotAssignCorrectorsAuto num@Int64: #{num} Abgaben konnten nicht automatisch zugewiesen werden:
+CouldNotAssignCorrectorsAuto num@Int64: #{num} #{pluralDE num "Abgabe konnte" "Abgaben konnten"} nicht automatisch zugewiesen werden:
 SelfCorrectors num@Int64: #{num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt!
 
 SubmissionOriginal: Original
@@ -604,20 +622,21 @@ RatingNotUnicode uexc@UnicodeException: Bewertungsdatei nicht in UTF-8 kodiert:
 RatingMissingSeparator: Präambel der Bewertungsdatei konnte nicht identifziert werden
 RatingMultiple: Bewertungen enthält mehrere Punktzahlen für die gleiche Abgabe
 RatingInvalid parseErr@Text: Bewertungspunktzahl konnte nicht als Zahl verstanden werden: #{parseErr}
-RatingFileIsDirectory: Unerwarteter Fehler: Datei ist unerlaubterweise ein Verzeichnis
+RatingFileIsDirectory: Bewertungsdatei ist unerlaubterweise ein Verzeichnis
 RatingNegative: Bewertungspunkte dürfen nicht negativ sein
 RatingExceedsMax: Bewertung übersteigt die erlaubte Maximalpunktzahl
 RatingNotExpected: Keine Bewertungen erlaubt
 RatingBinaryExpected: Bewertung muss 0 (=durchgefallen) oder 1 (=bestanden) sein
 RatingPointsRequired: Bewertung erfordert für dieses Blatt eine Punktzahl
+RatingFile: Bewertungsdatei
 
 SubmissionSinkExceptionDuplicateFileTitle file@FilePath: Dateiname #{show file} kommt mehrfach im Zip-Archiv vor
 SubmissionSinkExceptionDuplicateRating: Mehr als eine Bewertung gefunden.
 SubmissionSinkExceptionRatingWithoutUpdate: Bewertung gefunden, es ist hier aber keine Bewertung der Abgabe möglich.
 SubmissionSinkExceptionForeignRating smid@CryptoFileNameSubmission: Fremde Bewertung für Abgabe #{toPathPiece smid} enthalten. Bewertungen müssen sich immer auf die gleiche Abgabe beziehen!
-SubmissionSinkExceptionInvalidFileTitleExtension file@FilePath: Dateiname #{show file} hat keine der für dieses Übungsblatt zulässigen Dateiendungen.
+SubmissionSinkExceptionInvalidFileTitleExtension file@FilePath: Dateiname „#{show file}“ hat keine der für dieses Übungsblatt zulässigen Dateiendungen.
 
-MultiSinkException name@Text error@Text: In Abgabe #{name} ist ein Fehler aufgetreten: #{error}
+MultiSinkException name@Text error@Text: In Abgabe „#{name}“ ist ein Fehler aufgetreten: #{error}
 
 NoTableContent: Kein Tabelleninhalt
 NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter
@@ -627,7 +646,7 @@ AdminHeading: Administration
 AdminUserHeading: Benutzeradministration
 AdminUserRightsHeading: Benutzerrechte
 AdminUserAuthHeading: Benutzer-Authentifizierung
-AdminUserHeadingFor: Benuterprofil für
+AdminUserHeadingFor: Benutzerprofil für
 AdminFor: Administrator
 LecturerFor: Dozent
 LecturersFor: Dozenten
@@ -635,7 +654,6 @@ AssistantFor: Assistent
 AssistantsFor: Assistenten
 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: Berechtigungen erfolgreich verändert
 AccessRightsNotChanged: Berechtigungen wurden nicht verändert
@@ -647,7 +665,7 @@ DateTimeFormat: Datums- und Uhrzeitformat
 DateFormat: Datumsformat
 TimeFormat: Uhrzeitformat
 DownloadFiles: Dateien automatisch herunterladen
-DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden).
+DownloadFilesTip: Wenn gesetzt werden Dateien automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden).
 WarningDays: Fristen-Vorschau
 WarningDaysTip: Wie viele Tage im Voraus sollen Fristen von Klausuren etc. auf Ihrer Startseite angezeigt werden?
 NotificationSettings: Erwünschte Benachrichtigungen
@@ -659,6 +677,10 @@ FormCosmetics: Oberfläche
 FormPersonalAppearance: Öffentliche Daten
 FormFieldRequiredTip: Gekennzeichnete Pflichtfelder sind immer auszufüllen
 
+PersonalInfoExamAchievementsWip: Die Anzeige von Prüfungsergebnissen wird momentan an dieser Stelle leider noch nicht unterstützt.
+PersonalInfoOwnTutorialsWip: Die Anzeige von Tutorien, zu denen Sie als Tutor eingetragen sind wird momentan an dieser Stelle leider noch nicht unterstützt.
+PersonalInfoTutorialsWip: Die Anzeige von Tutorien, zu denen Sie angemeldet sind wird momentan an dieser Stelle leider noch nicht unterstützt.
+
 ActiveAuthTags: Aktivierte Authorisierungsprädikate
 
 InvalidDateTimeFormat: Ungültiges Datums- und Zeitformat, JJJJ-MM-TTTHH:MM[:SS] Format erwartet
@@ -725,8 +747,8 @@ UploadSpecificFileRequired: Zur Abgabe erforderlich
 
 NoSubmissions: Keine Abgabe
 CorrectorSubmissions: Abgabe extern mit Pseudonym
-UserSubmissions: Direkte Abgabe
+UserSubmissions: Direkte Abgabe in Uni2work
-BothSubmissions: Abgabe direkt & extern mit Pseudonym
+BothSubmissions: Abgabe direkt in Uni2work & extern mit Pseudonym
 
 SheetCorrectorSubmissionsTip: Abgabe erfolgt über ein Uni2work-externes Verfahren (zumeist in Papierform durch Einwurf) unter Angabe eines persönlichen Pseudonyms. Korrektoren können mithilfe des Pseudonyms später Korrekturergebnisse in Uni2work eintragen, damit Sie sie einsehen können.
 
@@ -738,8 +760,10 @@ SubmissionUpdated: Abgabe erfolgreich ersetzt
 AdminFeaturesHeading: Studiengänge
 StudyTerms: Studiengänge
 StudyTerm: Studiengang
-NoStudyTermsKnown: Nicht eingeschrieben
+NoStudyTermsKnown: Keine Studiengänge bekannt
 StudyFeatureInference: Studiengangschlüssel-Inferenz
+StudyFeatureInferenceNoConflicts: Keine Konflikte beobachtet
+StudyFeatureInferenceConflictsHeading: Studiengangseinträge mit beobachteten Konflikten
 StudyFeatureAge: Fachsemester
 StudyFeatureDegree: Abschluss
 FieldPrimary: Hauptfach
@@ -757,9 +781,9 @@ DegreeShort: Abschlusskürzel
 StudyTermsKey: Studiengangschlüssel
 StudyTermsName: Studiengang
 StudyTermsShort: Studiengangkürzel
-StudyTermsChangeSuccess: Zuordnung Abschlüsse aktualisiert
+StudyTermsChangeSuccess: Zuordnung Studiengänge aktualisiert
-StudyDegreeChangeSuccess: Zuordnung Studiengänge aktualisiert
+StudyDegreeChangeSuccess: Zuordnung Abschlüsse aktualisiert
-StudyCandidateIncidence: Anmeldevorgang
+StudyCandidateIncidence: Synchronisation
 AmbiguousCandidatesRemoved n@Int: #{show n} #{pluralDE n "uneindeutiger Kandidat" "uneindeutige Kandiaten"} entfernt
 RedundantCandidatesRemoved n@Int: #{show n} bereits #{pluralDE n "bekannter Kandidat" "bekannte Kandiaten"} entfernt
 CandidatesInferred n@Int: #{show n} neue #{pluralDE n "Studiengangszuordnung" "Studiengangszuordnungen"} inferiert
@@ -778,6 +802,8 @@ MailTestDateTime: Test der Datumsformattierung:
 
 German: Deutsch
 GermanGermany: Deutsch (Deutschland)
+English: Englisch
+EnglishEurope: Englisch (Europa)
 
 MailSubjectSubmissionRated csh@CourseShorthand: Ihre #{csh}-Abgabe wurde korrigiert
 MailSubmissionRatedIntro courseName@Text termDesc@Text: Ihre Abgabe im Kurs #{courseName} (#{termDesc}) wurde korrigiert.
@@ -859,9 +885,9 @@ MailSubjectExamOfficeUserInvitation displayName@Text: Berücksichtigung von Prü
 MailSubjectPasswordReset: Uni2work-Passwort ändern bzw. setzen
 
 SheetGrading: Bewertung
-SheetGradingPoints maxPoints@Points: #{maxPoints} Punkte
+SheetGradingPoints maxPoints@Points: #{maxPoints} #{pluralDE maxPoints "Punkt" "Punkte"}
-SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{passingPoints} von #{maxPoints} Punkten
+SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{passingPoints} von #{maxPoints} #{pluralDE maxPoints "Punkt" "Punkten"}
-SheetGradingPassBinary:  Bestanden/Nicht Bestanden
+SheetGradingPassBinary: Bestanden/Nicht Bestanden
 SheetGradingInfo: "Bestanden nach Punkten" zählt sowohl zur maximal erreichbaren Gesamtpunktzahl also auch zur Anzahl der zu bestehenden Blätter.
 
 SheetGradingCount': Anzahl
@@ -915,10 +941,10 @@ NotificationTriggerExamRegistrationSoonInactive: Ich kann mich bald nicht mehr f
 NotificationTriggerExamDeregistrationSoonInactive: Ich kann mich bald nicht mehr von einer Prüfung abmelden
 NotificationTriggerExamResult: Ich kann ein neues Prüfungsergebnis einsehen
 NotificationTriggerAllocationStaffRegister: Ich kann Kurse bei einer neuen Zentralanmeldung eintragen 
-NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldung-Bewerbungen für einen meiner Kurse bewerten
+NotificationTriggerAllocationAllocation: Ich kann Zentralanmeldungs-Bewerbungen für einen meiner Kurse bewerten
 NotificationTriggerAllocationRegister: Ich kann mich bei einer neuen Zentralanmeldung bewerben
-NotificationTriggerAllocationOutdatedRatings: Zentralanmeldung-Bewerbungen für einen meiner Kurse wurden verändert, nachdem sie bewertet wurden
+NotificationTriggerAllocationOutdatedRatings: Zentralanmeldungs-Bewerbungen für einen meiner Kurse wurden verändert, nachdem sie bewertet wurden
-NotificationTriggerAllocationUnratedApplications: Bewertungen zu Zentralanmeldung-Bewerbungen für einen meiner Kurse stehen aus
+NotificationTriggerAllocationUnratedApplications: Bewertungen zu Zentralanmeldungs-Bewerbungen für einen meiner Kurse stehen aus
 NotificationTriggerAllocationResults: Plätze wurden für eine meiner Zentralanmeldungen verteilt
 NotificationTriggerExamOfficeExamResults: Ich kann neue Prüfungsergebnisse einsehen
 NotificationTriggerExamOfficeExamResultsChanged: Prüfungsergebnisse wurden verändert
@@ -936,7 +962,7 @@ NotificationTriggerKindEvaluation: Für Vorlesungsumfragen
 NotificationTriggerKindAllocationStaff: Für Zentralanmeldungen (Dozenten)
 NotificationTriggerKindAllocationParticipant: Für Zentralanmeldungen
 
-CorrCreate: Abgaben erstellen
+CorrCreate: Abgaben registrieren
 UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"
 InvalidPseudonym pseudonym@Text: Invalides Pseudonym "#{pseudonym}"
 InvalidPseudonymSubmissionIgnored oPseudonyms@Text iPseudonym@Text: Abgabe mit Pseudonymen „#{oPseudonyms}“ wurde ignoriert, da „#{iPseudonym}“ nicht automatisiert zu einem validen Pseudonym korrigiert werden konnte.
@@ -956,6 +982,10 @@ SheetCreateExisting: Folgende Pseudonyme haben bereits abgegeben:
 CorrGrade: Korrekturen eintragen
 
 UserAccountDeleted name@Text: Konto für #{name} wurde gelöscht!
+UserSubmissionsDeleted n@Int: #{tshow n} Abgaben wurden unwiderruflich gelöscht.
+UserGroupSubmissionsKept n@Int: #{tshow n} Gruppenabgaben verbleiben in der Datenbank, aber die Zuordnung zum Benutzer wurde gelöscht. Gruppenabgaben können dadurch zu Einzelabgaben werden, die dann mit dem letzten Benutzer gelöscht werden.
+UserSubmissionGroupsDeleted count@Int64: #{tshow count} benannte Abgabengruppen wurden gelöscht, da sie ohne den Nutzer leer wären.
+UserAccountDeleteWarning: Achtung, dies löscht den kompletten Benutzer unwiderruflich und mit allen assoziierten Daten aus der Datenbank. Prüfungsdaten müssen jedoch langfristig gespeichert bleiben!
 
 HelpTitle : Hilfe
 HelpAnswer: Antworten an
@@ -1028,7 +1058,6 @@ EncodedSecretBoxCouldNotDecodeNonce: Konnte secretbox-nonce nicht dekodieren
 EncodedSecretBoxCouldNotOpenSecretBox: Konnte libsodium-secretbox nicht öffnen (Verschlüsselte Daten sind nicht authentisch)
 EncodedSecretBoxCouldNotDecodePlaintext aesonErr@String: Konnte Klartext nicht JSON-dekodieren: #{aesonErr}
 ErrMsgHeading: Fehlermeldung entschlüsseln
-ErrorCryptoIdMismatch: Verschlüsselte Id der Abgabe passte nicht zu anderen Daten
 
 InvalidRoute: Konnte URL nicht interpretieren
 
@@ -1065,6 +1094,7 @@ MenuProfileData: Persönliche Daten
 MenuTermCreate: Neues Semester anlegen
 MenuCourseNew: Neuen Kurs anlegen
 MenuTermEdit: Semester editieren
+MenuTermCurrent: Aktuelles Semester
 MenuCorrection: Korrektur
 MenuCorrections: Korrekturen
 MenuCorrectionsOwn: Meine Korrekturen
@@ -1093,8 +1123,8 @@ MenuCorrectionsUpload: Korrekturen hochladen
 MenuCorrectionsDownload: Offene Abgaben herunterladen
 MenuCorrectionsCreate: Abgaben registrieren
 MenuCorrectionsGrade: Abgaben online korrigieren
-MenuCorrectionsAssign: Zuteilung Korrekturen
+MenuCorrectionsAssign: Zuteilung der Korrekturen
-MenuCorrectionsAssignSheet name@Text: Zuteilung Korrekturen von #{name}
+MenuCorrectionsAssignSheet name@Text: Zuteilung der Korrekturen von #{name}
 MenuAuthPreds: Authorisierungseinstellungen
 MenuTutorialDelete: Tutorium löschen
 MenuTutorialEdit: Tutorium editieren
@@ -1108,7 +1138,7 @@ MenuExamAddMembers: Prüfungsteilnehmer hinzufügen
 MenuExamOfficeExams: Prüfungen
 MenuExamOfficeFields: Fächer
 MenuExamOfficeUsers: Benutzer
-MenuLecturerInvite: Dozenten hinzufügen
+MenuLecturerInvite: Funktionäre hinzufügen
 MenuAllocationInfo: Hinweise zum Ablauf einer Zentralanmeldung
 MenuCourseApplicationsFiles: Dateien aller Bewerbungen
 MenuSchoolList: Institute
@@ -1118,6 +1148,61 @@ MenuCourseNewsEdit: Kursnachricht bearbeiten
 MenuCourseEventNew: Neuer Kurstermin
 MenuCourseEventEdit: Kurstermin bearbeiten
 
+BreadcrumbSubmissionFile: Datei
+BreadcrumbSubmissionUserInvite: Einladung zur Abgabe
+BreadcrumbCryptoIDDispatch: CryptoID-Weiterleitung
+BreadcrumbCourseAppsFiles: Bewerbungsdateien
+BreadcrumbCourseNotes: Kursnotizen
+BreadcrumbHiWis: Korrektoren
+BreadcrumbMaterial: Material
+BreadcrumbSheet: Übungsblatt
+BreadcrumbTutorial: Tutorium
+BreadcrumbExam: Prüfung
+BreadcrumbApplicant: Bewerber
+BreadcrumbCourseRegister: Anmelden
+BreadcrumbCourseRegisterTemplate: Bewerbungsvorlagen
+BreadcrumbCourseFavourite: Favorisieren
+BreadcrumbCourse: Kurs
+BreadcrumbAllocationRegister: Teilnahme registrieren
+BreadcrumbAllocation: Zentralanmeldung
+BreadcrumbTerm: Semester
+BreadcrumbSchool: Institut
+BreadcrumbUser: Benutzer
+BreadcrumbStatic: Statische Resource
+BreadcrumbFavicon: Favicon
+BreadcrumbRobots: robots.txt
+BreadcrumbMetrics: Metriken
+BreadcrumbLecturerInvite: Einladung zum Kursverwalter
+BreadcrumbExamOfficeUserInvite: Einladung bzgl. Prüfungsleistungen
+BreadcrumbFunctionaryInvite: Einladung zum Instituts-Funktionär
+BreadcrumbUserDelete: Nutzer-Account löschen
+BreadcrumbUserHijack: Nutzer-Sitzung übernehmen
+BreadcrumbSystemMessage: Statusmeldung
+BreadcrumbSubmission: Abgabe
+BreadcrumbCourseNews: Kursnachricht
+BreadcrumbCourseNewsDelete: Kursnachricht löschen
+BreadcrumbCourseEventDelete: Kurstermin löschen
+BreadcrumbProfile: Einstellungen
+BreadcrumbAllocationInfo: Ablauf einer Zentralanmeldung
+BreadcrumbCourseParticipantInvitation: Einladung zum Kursteilnehmer
+BreadcrumbMaterialArchive: Archiv
+BreadcrumbMaterialFile: Datei
+BreadcrumbSheetArchive: Dateien
+BreadcrumbSheetIsCorrector: Korrektor-Überprüfung
+BreadcrumbSheetPseudonym: Pseudonym
+BreadcrumbSheetCorrectorInvite: Einladung zum Korrektor
+BreadcrumbSheetFile: Datei
+BreadcrumbTutorialRegister: Anmelden
+BreadcrumbTutorInvite: Einladung zum Tutor
+BreadcrumbExamCorrectorInvite: Einladung zum Prüfungskorrektor
+BreadcrumbExamParticipantInvite: Einladung zum Prüfungsteilnehmer
+BreadcrumbExamRegister: Anmelden
+BreadcrumbApplicationFiles: Bewerbungsdateien
+BreadcrumbCourseNewsArchive: Archiv
+BreadcrumbCourseNewsFile: Datei
+
+TitleMetrics: Metriken
+
 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
 AuthPredsActiveChanged: Authorisierungseinstellungen für aktuelle Sitzung gespeichert
@@ -1196,7 +1281,7 @@ RGTutorialParticipants: Tutorium-Teilnehmer
 
 MultiSelectFieldTip: Mehrfach-Auswahl ist möglich (Umschalt bzw. Strg)
 MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Addressen möglich
-EmailInvitationWarning: Dem System ist kein Nutzer mit dieser Addresse bekannt. Es wird eine Einladung per E-Mail versandt.
+EmailInvitationWarning: Diese Adresse konnte mit Ihren aktuellen Rechten keinem Uni2work-Benutzer zugeordnet werden (ggf. unter gewissen Einschränkungen). Es wird eine Einladung per E-Mail versandt.
 
 LecturerInvitationAccepted lType@Text csh@CourseShorthand: Sie wurden als #{lType} für #{csh} eingetragen
 LecturerInvitationDeclined csh@CourseShorthand: Sie haben die Einladung, Kursverwalter für #{csh} zu werden, abgelehnt
@@ -1289,7 +1374,7 @@ TutorialTutorControlled: Tutoren dürfen Tutorium editieren
 TutorialTutorControlledTip: Sollen Tutoren beliebige Aspekte dieses Tutoriums (Name, Registrierungs-Gruppe, Raum, Zeit, andere Tutoren, ...) beliebig editieren dürfen?
 
 CourseExams: Prüfungen
-CourseTutorials: Übungen
+CourseTutorials: Tutorien
 
 ParticipantsN n@Int: #{n} Teilnehmer
 TutorialDeleteQuestion: Wollen Sie das unten aufgeführte Tutorium wirklich löschen?
@@ -1412,7 +1497,7 @@ ExamBonusRoundNonPositive: Vielfaches, auf das gerundet werden soll, muss positi
 ExamBonusRoundTip: Bonuspunkte werden kaufmännisch auf ein Vielfaches der angegeben Zahl gerundet.
 
 ExamAutomaticOccurrenceAssignment: Automatische Termin- bzw. Raumzuteilung
-ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer zum Zeitpunkt der Bekanntgabe der Raum- bzw. Terminzuteilung automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
+ExamAutomaticOccurrenceAssignmentTip: Sollen Prüfungsteilnehmer automatisch auf die zur Verfügung stehenden Räume bzw. Termine verteilt werden? Manuelle Umverteilung bzw. vorheriges Festlegen von Zuteilungen einzelner Teilnehmer ist trotzdem möglich.
 ExamOccurrenceRule: Verfahren
 ExamOccurrenceRuleParticipant: Termin- bzw. Raumzuteilungsverfahren
 ExamRoomManual': Keine automatische Zuteilung
@@ -1457,7 +1542,7 @@ ExamPartName: Titel
 ExamPartNameTip: Wird den Studierenden angezeigt
 ExamPartMaxPoints: Maximalpunktzahl
 ExamPartWeight: Gewichtung
-ExamPartWeightTip: Wird vor Anzeige oder Notenberechnung mit der erreichten Punktzahl und der Maximalpunktzahl multipliziert; Änderungen hier passen auch bestehende Korrekturergebnisse an
+ExamPartWeightTip: Wird vor Anzeige oder automatischen Notenberechnung mit der erreichten Punktzahl und der Maximalpunktzahl multipliziert; Änderungen hier passen also auch bestehende Korrekturergebnisse an (derart geänderte Noten müssen erneut manuell übernommen werden)
 ExamPartResultPoints: Erreichte Punkte
 
 ExamNameTaken exam@ExamName: Es existiert bereits eine Prüfung mit Namen #{exam}
@@ -1527,6 +1612,8 @@ ExamUserMarkedSynchronised n@Int: #{n} #{pluralDE n "Prüfungsleistung" "Prüfun
 ExamOfficeExamUsersHeading: Prüfungsleistungen
 
 CsvFile: CSV-Datei
+CsvImport: CSV-Import
+CsvExport: CSV-Export
 CsvModifyExisting: Existierende Einträge angleichen
 CsvAddNew: Neue Einträge einfügen
 CsvDeleteMissing: Fehlende Einträge entfernen
@@ -1681,6 +1768,7 @@ SchoolFunctionInvitationAccepted school@SchoolName renderedFunction@Text: #{rend
 AllocationActive: Aktiv
 AllocationName: Name
 AllocationAvailableCourses: Kurse
+AllocationApplication: Bewerbung
 AllocationAppliedCourses: Bewerbungen
 AllocationNumCoursesAvailableApplied available@Int applied@Int: Sie haben sich bisher für #{applied}/#{available} #{pluralDE applied "Kurs" "Kursen"} beworben
 AllocationTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'}: #{allocation}
@@ -1879,7 +1967,7 @@ AcceptApplicationsSecondaryRandom: Zufällig
 AcceptApplicationsSecondaryTime: Nach Zeitpunkt der Bewerbung
 
 CsvOptions: CSV-Optionen
-CsvOptionsTip: Diese Einstellungen betreffen nur den CSV-Export; beim Import werden die verwendeten Einstellungen automatisch ermittelt. Als Zeichenkodierung wird beim Import stets Unicode erwartet.
+CsvOptionsTip: Diese Einstellungen betreffen primär den CSV-Export; beim Import werden die meisten Einstellungen automatisch ermittelt. Als Zeichenkodierung wird beim Import die selbe Kodierung wie beim Export erwartet.
 CsvFormatOptions: Dateiformat
 CsvTimestamp: Zeitstempel
 CsvTimestampTip: Soll an den Namen jeder exportierten CSV-Datei ein Zeitstempel vorne angehängt werden?
@@ -1898,6 +1986,7 @@ CsvDelimiterNull: Null-Byte
 CsvDelimiterTab: Tabulator
 CsvDelimiterComma: Komma
 CsvDelimiterColon: Doppelpunkt
+CsvDelimiterSemicolon: Strichpunkt
 CsvDelimiterBar: Senkrechter Strich
 CsvDelimiterSpace: Leerzeichen
 CsvDelimiterUnitSep: Teilgruppentrennzeichen
@@ -1989,5 +2078,67 @@ ShowSex: Geschlechter anderer Nutzer anzeigen
 ShowSexTip: Sollen in Kursteilnehmer-Tabellen u.Ä. die Geschlechter der Nutzer angezeigt werden?
 
 StudySubTermsParentKey: Elter
-StudyTermsDefaultDegree: Abschluss
+StudyTermsDefaultDegree: Default Abschluss
-StudyTermsDefaultFieldType: Typ
+StudyTermsDefaultFieldType: Default Typ
+
+MenuLanguage: Sprache
+LanguageChanged: Sprache erfolgreich geändert
+
+ProfileCorrector: Korrektor
+ProfileCourses: Eigene Kurse
+ProfileCourseParticipations: Kursanmeldungen
+ProfileCourseExamResults: Prüfungsleistungen
+ProfileTutorials: Eigene Tutorien
+ProfileTutorialParticipations: Tutorien
+ProfileSubmissionGroups: Abgabegruppen
+ProfileSubmissions: Abgaben
+ProfileRemark: Hinweis
+ProfileGroupSubmissionDates: Bei Gruppenabgaben wird kein Datum angezeigt, wenn Sie die Gruppenabgabe nie selbst hochgeladen haben.
+ProfileCorrectorRemark: Die oberhalb angezeigte Tabelle zeigt nur prinzipielle Einteilungen als Korrektor zu einem Übungsblatt. Auch ohne Einteilung können Korrekturen einzeln zugewiesen werden, welche hier dann nicht aufgeführt werden.
+ProfileCorrections: Auflistung aller zugewiesenen Korrekturen
+
+GroupSizeNotNatural: „Gruppengröße“ muss eine natürliche Zahl sein
+AmbiguousEmail: E-Mail Adresse nicht eindeutig
+CourseDescriptionPlaceholder: Bitte mindestens die Modulbeschreibung angeben
+CourseHomepageExternalPlaceholder: Optionale externe URL
+PointsPlaceholder: Punktezahl
+RFC1766: RFC1766-Sprachcode
+
+TermShort: Kürzel
+TermCourseCount: Kurse
+TermStart: Semesteranfang
+TermEnd: Semesterende
+TermStartMustMatchName: Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein.
+TermEndMustBeAfterStart: Semester darf nicht enden, bevor es beginnt.
+TermLectureEndMustBeAfterStart: Vorlesungszeit muss vor ihrem Ende anfgangen.
+TermStartMustBeBeforeLectureStart: Semester muss vor der Vorlesungszeit beginnen.
+TermEndMustBeAfterLectureEnd: Vorlesungszeit muss vor dem Semester enden.
+AdminPageEmpty: Diese Seite soll eine Übersichtsseite für Administratoren werden. Aktuell finden sich hier nur Links zu wichtigen Administrator-Funktionalitäten.
+HaveCorrectorAccess sheetName@SheetName: Sie haben Korrektor-Zugang zu #{original sheetName}.
+FavouritesPlaceholder: Anzahl Favoriten
+FavouritesNotNatural: Anzahl der Favoriten muss eine natürliche Zahl sein!
+FavouritesSemestersPlaceholder: Anzahl Semester
+FavouritesSemestersNotNatural: Anzahl der Favoriten-Semester muss eine natürliche Zahl sein!
+
+ProfileTitle: Benutzereinstellungen
+
+GlossaryTitle: Begriffsverzeichnis
+MenuGlossary: Begriffsverzeichnis
+
+Applicant: Bewerber
+CourseParticipant: Kursteilnehmer
+Administrator: Administrator
+CsvFormat: CSV-Format
+ExerciseSheet: Übungsblatt
+DefinitionCourseEvents: Kurstermine
+DefinitionCourseNews: Kurs-Aktuelles
+Invitations: Einladungen
+SheetSubmission: Abgabe
+CommCourse: Kursmitteilung
+CommTutorial: Tutorium-Mitteilung
+Clone: Klonen
+Deficit: Defizit
+
+MetricNoSamples: Keine Messwerte
+MetricName: Name
+MetricValue: Wert

models/files.model

@@ -6,3 +6,9 @@ File
     content         ByteString Maybe -- Nothing iff this is a directory
     modified        UTCTime
     deriving Show Eq Generic
+
+SessionFile
+    user            UserId
+    reference       SessionFileReference
+    file            FileId
+    touched         UTCTime

models/jobs.model

@@ -16,3 +16,10 @@ CronLastExec
     time                UTCTime -- When was the job executed
     instance            InstanceId -- Which uni2work-instance did the work
     UniqueCronLastExec job
+
+
+SentNotification
+    content             Value
+    user                UserId
+    time                UTCTime
+    instance            InstanceId

models/sheets.model

@@ -6,8 +6,8 @@ Sheet   -- exercise sheet for a given course
     grouping        SheetGroup       -- May participants submit in groups of certain sizes?
     markingText     Html Maybe       -- Instructons for correctors, included in marking templates
     visibleFrom     UTCTime Maybe    -- Invisible to enrolled participants before
-    activeFrom      UTCTime          -- Download of questions and submission is permitted afterwards
+    activeFrom      UTCTime Maybe    -- Download of questions and submission is permitted afterwards
-    activeTo        UTCTime          -- Submission is only permitted before
+    activeTo        UTCTime Maybe    -- Submission is only permitted before
     hintFrom        UTCTime Maybe    -- Additional files are made available
     solutionFrom    UTCTime Maybe    -- Solution is made available
     submissionMode  SubmissionMode   -- Submission upload by students and/or through tutors?

models/users.model

@@ -28,7 +28,7 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
     dateFormat     DateTimeFormat "default='%d.%m.%Y'"       -- preferred Date-only display format for user; user-defined
     timeFormat     DateTimeFormat "default='%R'"             -- preferred Time-only display format for user; user-defined
     downloadFiles  Bool default=false           -- Should files be opened in browser or downloaded? (users often oblivious that their browser has a setting for this)
-    mailLanguages  MailLanguages "default='[]'::jsonb"  -- Preferred language for eMail; i18n not yet implemented; user-defined
+    languages      Languages Maybe          -- Preferred language; user-defined
     notificationSettings NotificationSettings   -- Bit-array for which events email notifications are requested by user; user-defined
     warningDays    NominalDiffTime default=1209600 -- timedistance to pending deadlines for homepage infos
     csvOptions     CsvOptions "default='{}'::jsonb"
@@ -102,4 +102,13 @@ StudySubTermParentCandidate
 StudyTermStandaloneCandidate
     incidence     TermCandidateIncidence
     key           Int
-    deriving Show Eq Ord
+    deriving Show Eq Ord
+
+UserGroupMember
+    group         UserGroupName
+    user          UserId
+    primary       Checkmark nullable
+
+    UniquePrimaryUserGroupMember group primary !force
+    UniqueUserGroupMember group user
+    

package-lock.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "7.19.2",
+  "version": "7.25.1",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "7.19.2",
+  "version": "7.25.1",
   "description": "",
   "keywords": [],
   "author": "",
@@ -42,10 +42,10 @@
     "scripts": {
       "postbump": "./sync-versions.hs && git add -- package.yaml"
     },
-    "commitUrlFormat": "https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/{{hash}}",
+    "commitUrlFormat": "https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/{{hash}}",
-    "compareUrlFormat": "https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/{{previousTag}}...{{currentTag}}",
+    "compareUrlFormat": "https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/{{previousTag}}...{{currentTag}}",
-    "issueUrlFormat": "https://gitlab.cip.ifi.lmu.de/jost/UniWorX/issues/{{id}}",
+    "issueUrlFormat": "https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/{{id}}",
-    "userUrlFormat": "https://gitlab.cip.ifi.lmu.de/{{user}}"
+    "userUrlFormat": "https://gitlab2.rz.ifi.lmu.de/{{user}}"
   },
   "browserslist": [
     "defaults"

package.yaml

@@ -1,5 +1,5 @@
 name:    uniworx
-version: 7.19.2
+version: 7.25.1
 
 dependencies:
   - base >=4.9.1.0 && <5
@@ -140,6 +140,10 @@ dependencies:
   - retry
   - generic-lens
   - array
+  - cookie
+  - prometheus-client
+  - prometheus-metrics-ghc
+  - wai-middleware-prometheus
 
 other-extensions:
   - GeneralizedNewtypeDeriving
@@ -233,10 +237,7 @@ executables:
   uniworx:
     main: main.hs
     source-dirs: app
-    ghc-options:
+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T"
-      - -threaded
-      - -rtsopts
-      - -with-rtsopts=-N
     dependencies:
       - uniworx
     when:

routes

@@ -40,7 +40,8 @@
 /auth   AuthR   Auth   getAuth                                !free
 
 /favicon.ico FaviconR GET                                     !free
-/robots.txt RobotsR GET                                       !free
+/robots.txt  RobotsR  GET                                     !free
+/metrics     MetricsR GET
 
 /                             HomeR            GET            !free
 /users                        UsersR           GET POST       -- no tags, i.e. admins only
@@ -63,6 +64,7 @@
 /info/lecturer                InfoLecturerR    GET             !lecturer
 /info/data                    DataProtR        GET             !free
 /info/allocation              InfoAllocationR  GET             !free
+/info/glossary                GlossaryR        GET             !free
 /impressum                    ImpressumR       GET             !free
 /version                      VersionR         GET             !free
 
@@ -73,6 +75,7 @@
 /user/authpreds            AuthPredsR          GET POST        !free
 /user/set-display-email    SetDisplayEmailR    GET POST        !free
 /user/csv-options          CsvOptionsR         GET POST        !free
+/user/lang                 LangR                   POST        !free
 
 /exam-office               ExamOfficeR                         !exam-office:
   /                        EOExamsR            GET
@@ -141,7 +144,6 @@
       /invite                   SInviteR       GET POST        !ownerANDtimeANDuser-submissions
       !/#SubmissionFileType     SubArchiveR    GET             !owner !corrector
       !/#SubmissionFileType/*FilePath SubDownloadR  GET        !owner !corrector
-    /correctors                 SCorrR         GET POST
     /iscorrector                SIsCorrR       GET             !corrector -- Route is used to check for corrector access to this sheet
     /pseudonym                  SPseudonymR    GET POST        !course-registeredANDcorrector-submissions
     /corrector-invite/          SCorrInviteR   GET POST

src/Application.hs

@@ -22,6 +22,8 @@ import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
 import Import                        hiding (cancel)
 import Language.Haskell.TH.Syntax           (qLocation)
 import Network.Wai (Middleware)
+import qualified Network.Wai as Wai
+import qualified Network.HTTP.Types as HTTP
 import Network.Wai.Handler.Warp             (Settings, defaultSettings,
                                              defaultShouldDisplayException,
                                              runSettings, runSettingsSocket, setHost,
@@ -48,6 +50,7 @@ import System.Directory
 import Jobs
 
 import qualified Data.Text.Encoding as Text
+
 import Yesod.Auth.Util.PasswordStore
 
 import qualified Data.ByteString.Lazy as LBS
@@ -81,12 +84,20 @@ import Network.Socket (socketPort, Socket, PortNumber)
 import qualified Network.Socket as Socket (close)
 
 import Control.Concurrent.STM.Delay
-import Control.Monad.STM (retry)
 import Control.Monad.Trans.Cont (runContT, callCC)
 
 import qualified Data.Set as Set
 
-import Data.Semigroup (Max(..), Min(..))
+import Data.Semigroup (Min(..))
+
+import qualified Prometheus.Metric.GHC as Prometheus
+import qualified Prometheus
+
+import Data.Time.Clock.POSIX
+
+import Handler.Utils.Routes (classifyHandler)
+
+import Data.List (cycle)
 
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
@@ -111,6 +122,7 @@ import Handler.Health
 import Handler.Exam
 import Handler.Allocation
 import Handler.ExamOffice
+import Handler.Metrics
 
 
 -- This line actually creates our YesodDispatch instance. It is the second half
@@ -124,6 +136,8 @@ mkYesodDispatch "UniWorX" resourcesUniWorX
 -- migrations handled by Yesod.
 makeFoundation :: (MonadResource m, MonadUnliftIO m) => AppSettings -> m UniWorX
 makeFoundation appSettings'@AppSettings{..} = do
+    void $ Prometheus.register Prometheus.ghcMetrics
+  
     -- Some basic initializations: HTTP connection manager, logger, and static
     -- subsite.
     appHttpManager <- newManager
@@ -290,7 +304,39 @@ makeApplication foundation = liftIO $ do
     logWare <- makeLogWare foundation
     -- Create the WAI application and apply middlewares
     appPlain <- toWaiAppPlain foundation
-    return $ logWare $ defaultMiddlewaresNoLogging appPlain
+    return . prometheusMiddleware . logWare $ defaultMiddlewaresNoLogging appPlain
+  where
+    prometheusMiddleware :: Middleware
+    prometheusMiddleware app req respond' = do
+      start <- getPOSIXTime
+      app req $ \res -> do
+        end <- getPOSIXTime
+        let method  = decodeUtf8 $ Wai.requestMethod req
+            status  = tshow . HTTP.statusCode $ Wai.responseStatus res
+            route :: Maybe (Route UniWorX)
+            route   = parseRoute ( Wai.pathInfo req
+                                 , over (mapped . _2) (fromMaybe "") . HTTP.queryToQueryText $ Wai.queryString req
+                                 )
+            handler' = pack . classifyHandler <$> route
+
+            labels :: Prometheus.Label3
+            labels = (fromMaybe "n/a" handler', method, status)
+        Prometheus.withLabel requestLatency labels . flip Prometheus.observe . realToFrac $ end - start
+
+        respond' res
+
+{-# NOINLINE requestLatency #-}
+requestLatency :: Prometheus.Vector Prometheus.Label3 Prometheus.Histogram
+requestLatency = Prometheus.unsafeRegister
+               $ Prometheus.vector ("handler", "method", "status")
+               $ Prometheus.histogram info buckets
+  where info = Prometheus.Info "http_request_duration_seconds"
+                               "HTTP request latency"
+        buckets = map fromRational . takeWhile (<= 500) . go 50e-6 $ cycle [2, 2, 2.5]
+          where
+            go n []     = [n]
+            go n (f:fs) = n : go (f * n) fs
+
 
 makeLogWare :: MonadIO m => UniWorX -> m Middleware
 makeLogWare app = do
@@ -320,13 +366,22 @@ makeLogWare app = do
     logWare <- either mkLogWare return lookupRes
     logWare wai req fin
 
+data ReadySince = MkReadySince
+
 -- | Warp settings for the given foundation value.
 warpSettings :: UniWorX -> Settings
 warpSettings foundation = defaultSettings
     & setBeforeMainLoop (runAppLoggingT foundation $ do
                             let notifyReady = do
                                   $logInfoS "setup" "Ready"
-                                  void $ liftIO Systemd.notifyReady
+                                  void . liftIO $ do
+                                    void . Prometheus.register . readyMetric =<< getCurrentTime
+                                    Systemd.notifyReady
+                                readyMetric ts = Prometheus.Metric $ return (MkReadySince, collectReadySince)
+                                  where
+                                    collectReadySince = return [Prometheus.SampleGroup info Prometheus.GaugeType [Prometheus.Sample "ready_time" [] sample]]
+                                    info = Prometheus.Info "ready_time" "POSIXTime this Uni2work-instance became ready"
+                                    sample = encodeUtf8 . tshow . (realToFrac :: POSIXTime -> Nano) $ utcTimeToPOSIXSeconds ts
                             if
                               | foundation ^. _appHealthCheckDelayNotify
                                 -> void . forkIO $ do
@@ -425,39 +480,46 @@ appMain = runResourceT $ do
       case watchdogMicroSec of
         Just wInterval
           | maybe True (== myProcessID) watchdogProcess
-            -> let notifyWatchdog :: IO ()
+            -> let notifyWatchdog :: forall a. IO a
                    notifyWatchdog = runAppLoggingT foundation $ go Nothing
                      where
-                       go pStatus = do
+                       go :: Maybe (Set (UTCTime, HealthReport)) -> LoggingT IO a
-                         d <- liftIO . newDelay . floor $ wInterval % 2
+                       go pResults = do
+                         let delay = floor $ wInterval % 2
+                         d <- liftIO $ newDelay delay
 
-                         status <- atomically $ asum
+                         $logDebugS "Notify" $ "Waiting up to " <> tshow delay <> "µs..."
-                           [ Nothing <$ waitDelay d
+                         mResults <- atomically $ asum
-                           , Just <$> do
+                           [ pResults <$ waitDelay d
+                           , do
                                results <- readTVar $ foundation ^. _appHealthReport
-                               case fromNullable results of
+                               guardOn (pResults /= Just results) $ Just results
-                                 Nothing -> retry
-                                 Just rs -> do
-                                   let status = ofoldMap1 (Max *** Min . healthReportStatus) rs
-                                   guard $ pStatus /= Just status
-                                   return status
                            ]
 
-                         case status of
+                         $logDebugS "Notify" "Checking for status/watchdog..."
-                           Just (_, Min status') -> do
+                         (*> go mResults) . void . runMaybeT $ do
-                             $logInfoS "NotifyStatus" $ toPathPiece status'
+                           results <- hoistMaybe mResults
-                             liftIO . void . Systemd.notifyStatus . unpack $ toPathPiece status'
-                           Nothing -> return ()
 
-                         case status of
+                           Min status <- hoistMaybe $ ofoldMap1 (Min . healthReportStatus . view _2) <$> fromNullable results
-                           Just (_, Min HealthSuccess) -> do
+                           $logInfoS "NotifyStatus" $ toPathPiece status
-                             $logInfoS "NotifyWatchdog" "Notify"
+                           liftIO . void . Systemd.notifyStatus . unpack $ toPathPiece status
-                             liftIO $ void Systemd.notifyWatchdog
-                           _other -> return ()
 
-                         go status
+                           now <- liftIO getCurrentTime
-                in void $ allocateLinkedAsync notifyWatchdog
+                           iforM_ (foundation ^. _appHealthCheckInterval) . curry $ \case
-        _other -> return ()
+                             (_, Nothing) -> return ()
+                             (hc, Just interval) -> do
+                               lastSuccess <- hoistMaybe $ results
+                                 & Set.filter (\(_, rep) -> classifyHealthReport rep == hc)
+                                 & Set.filter (\(_, rep) -> healthReportStatus rep >= HealthSuccess)
+                                 & Set.mapMonotonic (view _1)
+                                 & Set.lookupMax
+                               guard $ lastSuccess > addUTCTime (negate interval) now
+                           $logInfoS "NotifyWatchdog" "Notify"
+                           liftIO $ void Systemd.notifyWatchdog
+                in do
+                     $logDebugS "Notify" "Spawning notify thread..."
+                     void $ allocateLinkedAsync notifyWatchdog
+        _other -> $logWarnS "Notify" "Not sending notifications of status/poking watchdog"
 
       let runWarp socket = runSettingsSocket (warpSettings foundation) socket app
       case sockets of

src/Auth/Dummy.hs

@@ -13,6 +13,7 @@ import qualified Data.CaseInsensitive as CI
 
 
 data DummyMessage = MsgDummyIdent
+                  | MsgDummyIdentPlaceholder
                   | MsgDummyNoFormData
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
@@ -24,7 +25,9 @@ dummyForm :: ( RenderMessage (HandlerSite m) FormMessage
              , Button (HandlerSite m) ButtonSubmit
              , MonadHandler m
              ) => AForm m (CI Text)
-dummyForm = areq (ciField & addDatalist userList) (fslI MsgDummyIdent & noAutocomplete) Nothing
+dummyForm = wFormToAForm $ do
+  mr <- getMessageRender
+  aFormToWForm $ areq (ciField & addDatalist userList) (fslpI MsgDummyIdent (mr MsgDummyIdentPlaceholder) & noAutocomplete & addName PostLoginDummy) Nothing
   where
     userList = fmap mkOptionList . runDB $ withReaderT projectBackend (map toOption <$> selectList [] [Asc UserIdent] :: ReaderT SqlBackend _ [Option UserIdent])
     toOption (Entity _ User{..}) = Option userDisplayName userIdent (CI.original userIdent)

src/Auth/LDAP.hs

@@ -36,6 +36,7 @@ data CampusLogin = CampusLogin
 data CampusMessage = MsgCampusIdentPlaceholder
                    | MsgCampusIdent
                    | MsgCampusPassword
+                   | MsgCampusPasswordPlaceholder
                    | MsgCampusSubmit
                    | MsgCampusInvalidCredentials
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
@@ -130,7 +131,7 @@ campusForm = do
   MsgRenderer mr <- getMsgRenderer
   
   ident <- wreq ciField (fslpI MsgCampusIdent (mr MsgCampusIdentPlaceholder) & addAttr "autofocus" "") Nothing
-  password <- wreq passwordField (fslI MsgCampusPassword) Nothing
+  password <- wreq passwordField (fslpI MsgCampusPassword (mr MsgCampusPasswordPlaceholder)) Nothing
 
   return $ CampusLogin
     <$> ident

src/Auth/PWHash.hs

@@ -22,7 +22,9 @@ data HashLogin = HashLogin
   } deriving (Generic, Typeable)
 
 data PWHashMessage = MsgPWHashIdent
+                   | MsgPWHashIdentPlaceholder
                    | MsgPWHashPassword
+                   | MsgPWHashPasswordPlaceholder
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
 
@@ -30,9 +32,11 @@ hashForm :: ( RenderMessage (HandlerSite m) FormMessage
             , RenderMessage (HandlerSite m) PWHashMessage
             , MonadHandler m
             ) => AForm m HashLogin
-hashForm = HashLogin
+hashForm = wFormToAForm $ do
-  <$> areq ciField (fslpI MsgPWHashIdent "Identifikation") Nothing
+  mr <- getMessageRender
-  <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing
+  aFormToWForm $ HashLogin
+    <$> areq ciField (fslpI MsgPWHashIdent (mr MsgPWHashIdentPlaceholder)) Nothing
+    <*> areq passwordField (fslpI MsgPWHashPassword (mr MsgPWHashPasswordPlaceholder)) Nothing
 
 
 hashLogin :: forall site.

src/Cron.hs

@@ -155,7 +155,7 @@ nextCronMatch :: TZ -- ^ Timezone of the `Cron`-Entry
               -> UTCTime -- ^ Current time, used only for `CronCalendar`
               -> Cron
               -> CronNextMatch UTCTime
-nextCronMatch tz mPrev prec now c@Cron{..} = case notAfter of
+nextCronMatch tz mPrev prec now c@Cron{..} = onlyOnceWithinPrec $ case notAfter of
   MatchAsap -> MatchNone
   MatchAt ts
     | MatchAt ts' <- nextMatch
@@ -165,6 +165,16 @@ nextCronMatch tz mPrev prec now c@Cron{..} = case notAfter of
     | otherwise -> MatchNone
   MatchNone -> nextMatch
   where
+    onlyOnceWithinPrec sched = case mPrev of
+      Nothing -> sched
+      Just prevT -> case sched of
+        MatchAsap
+          | now >= addUTCTime prec prevT -> MatchAsap
+          | otherwise -> MatchAt $ addUTCTime prec prevT
+        MatchAt ts -> let ts' = max ts $ addUTCTime prec prevT
+                       in if | ts' <= addUTCTime prec now -> MatchAsap
+                             | otherwise -> MatchAt ts'
+        MatchNone  -> MatchNone
     notAfter
       | Right c' <- cronNotAfter
       , Just ref <- notAfterRef

src/Data/Universe/Instances/Reverse/WithIndex.hs

@@ -0,0 +1,20 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Data.Universe.Instances.Reverse.WithIndex
+  (
+  ) where
+
+import ClassyPrelude
+
+import Data.Universe
+import Control.Lens.Indexed
+
+import Data.Universe.Instances.Reverse ()
+
+import qualified Data.Map as Map
+
+
+instance Finite a => FoldableWithIndex a ((->) a) where
+  ifoldMap f g = fold [ f x (g x) | x <- universeF ]
+instance (Ord a, Finite a) => TraversableWithIndex a ((->) a) where
+  itraverse f g = (Map.!) . Map.fromList <$> sequenceA [ (x, ) <$> f x (g x) | x <- universeF ]

src/Database/Esqueleto/Utils.hs

@@ -19,6 +19,7 @@ module Database.Esqueleto.Utils
   , sha256
   , maybe
   , SqlProject(..)
+  , (->.)
   , module Database.Esqueleto.Utils.TH
   ) where
 
@@ -246,3 +247,6 @@ instance (PersistEntity val, PersistField typ) => SqlProject val typ (E.Entity v
 instance (PersistEntity val, PersistField typ) => SqlProject val typ (Maybe (E.Entity val)) (Maybe typ) where
   sqlProject = (E.?.)
   unSqlProject _ _ = Just
+
+(->.) :: E.SqlExpr (E.Value a) -> Text -> E.SqlExpr (E.Value b)
+(->.) expr t = E.unsafeSqlBinOp "->" expr $ E.val t

src/Foundation/I18n.hs

@@ -0,0 +1,313 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Foundation.I18n
+  ( UniWorXMessage(..)
+  , ShortTermIdentifier(..)
+  , MsgLanguage(..)
+  , ShortSex(..)
+  , SheetTypeHeader(..)
+  , ShortStudyDegree(..)
+  , ShortStudyTerms(..)
+  , StudyDegreeTerm(..)
+  , ShortStudyFieldType(..)
+  , StudyDegreeTermType(..)
+  , ErrorResponseTitle(..)
+  , UniWorXMessages(..)
+  , uniworxMessages
+  ) where
+
+import Foundation.Type
+
+
+import Import.NoFoundation
+
+import Auth.LDAP
+import Auth.PWHash
+import Auth.Dummy
+
+import Data.CaseInsensitive (original, mk)
+
+import qualified Data.Text as Text
+
+import Utils.Form
+
+import Text.Shakespeare.Text (st)
+
+import GHC.Exts (IsList(..))
+
+
+pluralDE :: (Eq a, Num a)
+            =>    a -- ^ Count
+            -> Text -- ^ Singular
+            -> Text -- ^ Plural
+            -> Text
+pluralDE num singularForm pluralForm
+  | num == 1  = singularForm
+  | otherwise = pluralForm
+
+noneOneMoreDE :: (Eq a, Num a)
+            =>    a -- ^ Count
+            -> Text -- ^ None
+            -> Text -- ^ Singular
+            -> Text -- ^ Plural
+            -> Text
+noneOneMoreDE num noneText singularForm pluralForm
+  | num == 0  = noneText
+  | num == 1  = singularForm
+  | otherwise = pluralForm
+
+-- noneMoreDE :: (Eq a, Num a)
+--             =>    a -- ^ Count
+--             -> Text -- ^ None
+--             -> Text -- ^ Some
+--             -> Text
+-- noneMoreDE num noneText someText
+--   | num == 0  = noneText
+--   | otherwise = someText
+
+pluralEN :: (Eq a, Num a)
+            =>    a -- ^ Count
+            -> Text -- ^ Singular
+            -> Text -- ^ Plural
+            -> Text
+pluralEN num singularForm pluralForm
+  | num == 1  = singularForm
+  | otherwise = pluralForm
+
+noneOneMoreEN :: (Eq a, Num a)
+            =>    a -- ^ Count
+            -> Text -- ^ None
+            -> Text -- ^ Singular
+            -> Text -- ^ Plural
+            -> Text
+noneOneMoreEN num noneText singularForm pluralForm
+  | num == 0  = noneText
+  | num == 1  = singularForm
+  | otherwise = pluralForm
+
+-- noneMoreEN :: (Eq a, Num a)
+--             =>    a -- ^ Count
+--             -> Text -- ^ None
+--             -> Text -- ^ Some
+--             -> Text
+-- noneMoreEN num noneText someText
+--   | num == 0  = noneText
+--   | otherwise = someText
+
+ordinalEN :: ToMessage a
+          => a
+          -> Text
+ordinalEN (toMessage -> numStr) = case lastChar of
+  Just '1' -> [st|#{numStr}st|]
+  Just '2' -> [st|#{numStr}nd|]
+  Just '3' -> [st|#{numStr}rd|]
+  _other   -> [st|#{numStr}th|]
+  where
+    lastChar = last <$> fromNullable numStr 
+
+
+-- Convenience Type for Messages, since Yesod messages cannot deal with compound type identifiers
+type IntMaybe  = Maybe Int
+
+-- | Convenience function for i18n messages definitions
+maybeToMessage :: ToMessage m => Text -> Maybe m -> Text -> Text
+maybeToMessage _      Nothing  _     = mempty
+maybeToMessage before (Just x) after = before <> toMessage x <> after
+
+-- Messages creates type UniWorXMessage and RenderMessage UniWorX instance
+mkMessage "UniWorX" "messages/uniworx" "de-de-formal"
+mkMessageVariant "UniWorX" "Campus" "messages/campus" "de"
+mkMessageVariant "UniWorX" "Dummy" "messages/dummy" "de"
+mkMessageVariant "UniWorX" "PWHash" "messages/pw-hash" "de"
+mkMessageVariant "UniWorX" "Button" "messages/button" "de"
+mkMessageVariant "UniWorX" "Frontend" "messages/frontend" "de-de-formal"
+
+instance RenderMessage UniWorX TermIdentifier where
+  renderMessage foundation ls TermIdentifier{..} = case season of
+    Summer -> renderMessage' $ MsgSummerTerm year
+    Winter -> renderMessage' $ MsgWinterTerm year
+    where renderMessage' = renderMessage foundation ls
+
+newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier
+  deriving stock (Eq, Ord, Read, Show)
+instance RenderMessage UniWorX ShortTermIdentifier where
+  renderMessage foundation ls (ShortTermIdentifier TermIdentifier{..}) = case season of
+    Summer -> renderMessage' $ MsgSummerTermShort year
+    Winter -> renderMessage' $ MsgWinterTermShort year
+    where renderMessage' = renderMessage foundation ls
+
+instance RenderMessage UniWorX String where
+  renderMessage f ls str = renderMessage f ls $ Text.pack str
+
+-- TODO: raw number representation; instead, display e.g. 1000 as 1.000 or 1,000 or ... (language-dependent!)
+instance RenderMessage UniWorX Int where
+  renderMessage f ls = renderMessage f ls . tshow
+instance RenderMessage UniWorX Int64 where
+  renderMessage f ls = renderMessage f ls . tshow
+instance RenderMessage UniWorX Integer where
+  renderMessage f ls = renderMessage f ls . tshow
+instance RenderMessage UniWorX Natural where
+  renderMessage f ls = renderMessage f ls . tshow
+
+instance HasResolution a => RenderMessage UniWorX (Fixed a) where
+  renderMessage f ls = renderMessage f ls . showFixed True
+
+instance RenderMessage UniWorX Load where
+  renderMessage foundation ls = renderMessage foundation ls . \case
+    Load { byTutorial = Nothing   , byProportion = p } -> MsgCorByProportionOnly p
+    Load { byTutorial = Just True , byProportion = p } -> MsgCorByProportionIncludingTutorial p
+    Load { byTutorial = Just False, byProportion = p } -> MsgCorByProportionExcludingTutorial p
+
+newtype MsgLanguage = MsgLanguage Lang
+  deriving stock (Eq, Ord, Show, Read)
+instance RenderMessage UniWorX MsgLanguage where
+  renderMessage foundation ls (MsgLanguage lang@(map mk . Text.splitOn "-" -> lang'))
+    | ("de" : "DE" : _) <- lang' = mr MsgGermanGermany
+    | ("de" : _)        <- lang' = mr MsgGerman
+    | ("en" : "EU" : _) <- lang' = mr MsgEnglishEurope
+    | ("en" : _)        <- lang' = mr MsgEnglish 
+    | otherwise = lang
+    where
+      mr = renderMessage foundation ls
+
+embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>)
+embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
+embedRenderMessage ''UniWorX ''StudyFieldType id
+embedRenderMessage ''UniWorX ''SheetFileType id
+embedRenderMessage ''UniWorX ''SubmissionFileType id
+embedRenderMessage ''UniWorX ''CorrectorState id
+embedRenderMessage ''UniWorX ''RatingException id
+embedRenderMessage ''UniWorX ''SubmissionSinkException ("SubmissionSinkException" <>)
+embedRenderMessage ''UniWorX ''SheetGrading ("SheetGrading" <>)
+embedRenderMessage ''UniWorX ''AuthTag $ ("AuthTag" <>) . concat . drop 1 . splitCamel
+embedRenderMessage ''UniWorX ''EncodedSecretBoxException id
+embedRenderMessage ''UniWorX ''LecturerType id
+embedRenderMessage ''UniWorX ''SubmissionModeDescr
+  $ let verbMap [_, _, "None"] = "NoSubmissions"
+        verbMap [_, _, v] = v <> "Submissions"
+        verbMap _ = error "Invalid number of verbs"
+     in verbMap . splitCamel
+embedRenderMessage ''UniWorX ''UploadModeDescr id
+embedRenderMessage ''UniWorX ''SecretJSONFieldException id
+embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel
+embedRenderMessage ''UniWorX ''SchoolFunction id
+embedRenderMessage ''UniWorX ''CsvPreset id
+embedRenderMessage ''UniWorX ''Quoting ("Csv" <>)
+embedRenderMessage ''UniWorX ''FavouriteReason id
+embedRenderMessage ''UniWorX ''Sex id
+
+embedRenderMessage ''UniWorX ''AuthenticationMode id
+
+newtype ShortSex = ShortSex Sex
+embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>)
+
+newtype SheetTypeHeader = SheetTypeHeader SheetType
+embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)
+
+instance RenderMessage UniWorX SheetType where
+  renderMessage foundation ls sheetType = case sheetType of
+      NotGraded -> mr $ SheetTypeHeader NotGraded
+      other -> mr (grading other) <> ", " <> mr (SheetTypeHeader other)
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
+instance RenderMessage UniWorX StudyDegree where
+  renderMessage _found _ls StudyDegree{..} = fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand)
+
+newtype ShortStudyDegree = ShortStudyDegree StudyDegree
+
+instance RenderMessage UniWorX ShortStudyDegree where
+  renderMessage _found _ls (ShortStudyDegree StudyDegree{..}) = fromMaybe (tshow studyDegreeKey) studyDegreeShorthand
+
+instance RenderMessage UniWorX StudyTerms where
+  renderMessage _found _ls StudyTerms{..} = fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)
+
+newtype ShortStudyTerms = ShortStudyTerms StudyTerms
+
+instance RenderMessage UniWorX ShortStudyTerms where
+  renderMessage _found _ls (ShortStudyTerms StudyTerms{..}) = fromMaybe (tshow studyTermsKey) studyTermsShorthand
+
+data StudyDegreeTerm = StudyDegreeTerm StudyDegree StudyTerms
+
+instance RenderMessage UniWorX StudyDegreeTerm where
+  renderMessage foundation ls (StudyDegreeTerm deg trm) = mr trm <> " (" <> mr (ShortStudyDegree deg) <> ")"
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+  
+newtype ShortStudyFieldType = ShortStudyFieldType StudyFieldType
+embedRenderMessageVariant ''UniWorX ''ShortStudyFieldType ("Short" <>)
+
+data StudyDegreeTermType = StudyDegreeTermType StudyDegree StudyTerms StudyFieldType
+
+instance RenderMessage UniWorX StudyDegreeTermType where
+  renderMessage foundation ls (StudyDegreeTermType deg trm typ) = mr trm <> " (" <> mr (ShortStudyDegree deg) <> ", " <> mr (ShortStudyFieldType typ) <> ")"
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
+instance RenderMessage UniWorX ExamGrade where
+  renderMessage _ _ = pack . (showFixed False :: Deci -> String) . fromRational . review numberGrade
+
+instance RenderMessage UniWorX ExamPassed where
+  renderMessage foundation ls = \case
+    ExamPassed True  -> mr MsgExamPassed
+    ExamPassed False -> mr MsgExamNotPassed
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
+instance RenderMessage UniWorX a => RenderMessage UniWorX (ExamResult' a) where
+  renderMessage foundation ls = \case
+    ExamAttended{..} -> mr examResult
+    ExamNoShow       -> mr MsgExamResultNoShow
+    ExamVoided       -> mr MsgExamResultVoided
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
+instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where
+  renderMessage foundation ls = either mr mr
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
+-- ToMessage instances for converting raw numbers to Text (no internationalization)
+
+instance ToMessage Int where
+  toMessage = tshow
+instance ToMessage Int64 where
+  toMessage = tshow
+instance ToMessage Integer where
+  toMessage = tshow
+instance ToMessage Natural where
+  toMessage = tshow
+
+instance HasResolution a => ToMessage (Fixed a) where
+  toMessage = toMessage . showFixed True
+
+-- Do not use toMessage on Rationals and round them automatically. Instead, use rationalToFixed3 (declared in src/Utils.hs) to convert a Rational to Fixed E3!
+-- instance ToMessage Rational where
+--   toMessage = toMessage . fromRational'
+--     where fromRational' = fromRational :: Rational -> Fixed E3
+
+
+newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
+embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
+
+newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX]
+  deriving stock (Generic, Typeable)
+  deriving newtype (Semigroup, Monoid)
+
+instance IsList UniWorXMessages where
+  type Item UniWorXMessages = SomeMessage UniWorX
+  fromList = UniWorXMessages
+  toList (UniWorXMessages msgs) = msgs
+
+instance RenderMessage UniWorX UniWorXMessages where
+  renderMessage foundation ls (UniWorXMessages msgs) =
+    Text.unwords $ map (renderMessage foundation ls) msgs
+
+uniworxMessages :: [UniWorXMessage] -> UniWorXMessages
+uniworxMessages = UniWorXMessages . map SomeMessage

src/Foundation/Routes.hs

@@ -0,0 +1,10 @@
+module Foundation.Routes
+  ( uniworxRoutes
+  ) where
+
+import ClassyPrelude.Yesod
+import Yesod.Routes.TH.Types (ResourceTree)
+
+
+uniworxRoutes :: [ResourceTree String]
+uniworxRoutes = $(parseRoutesFile "routes")

src/Foundation/Type.hs

@@ -0,0 +1,58 @@
+module Foundation.Type
+  ( UniWorX(..)
+  , SMTPPool
+  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionKey, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport
+  ) where
+
+import Import.NoFoundation
+import Database.Persist.Sql (ConnectionPool)
+
+import qualified Web.ClientSession as ClientSession
+
+import Jobs.Types
+
+import Yesod.Core.Types (Logger)
+
+import Data.Set (Set)
+
+import qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import qualified Jose.Jwk as Jose
+
+import qualified Database.Memcached.Binary.IO as Memcached
+
+
+type SMTPPool = Pool SMTPConnection
+
+-- | The foundation datatype for your application. This can be a good place to
+-- keep settings and values requiring initialization before your application
+-- starts running, such as database connections. Every handler will have
+-- access to the data present here.
+data UniWorX = UniWorX
+    { appSettings'       :: AppSettings
+    , appStatic          :: EmbeddedStatic -- ^ Settings for static file serving.
+    , appConnPool        :: ConnectionPool -- ^ Database connection pool.
+    , appSmtpPool        :: Maybe SMTPPool
+    , appLdapPool        :: Maybe LdapPool
+    , appWidgetMemcached :: Maybe Memcached.Connection -- ^ Actually a proper pool
+    , appHttpManager     :: Manager
+    , appLogger          :: (ReleaseKey, TVar Logger)
+    , appLogSettings     :: TVar LogSettings
+    , appCryptoIDKey     :: CryptoIDKey
+    , appClusterID       :: ClusterId
+    , appInstanceID      :: InstanceId
+    , appJobState        :: TMVar JobState
+    , appSessionKey      :: ClientSession.Key
+    , appSecretBoxKey    :: SecretBox.Key
+    , appJSONWebKeySet   :: Jose.JwkSet
+    , appHealthReport    :: TVar (Set (UTCTime, HealthReport))
+    }
+
+makeLenses_ ''UniWorX
+instance HasInstanceID UniWorX InstanceId where
+  instanceID = _appInstanceID
+instance HasJSONWebKeySet UniWorX Jose.JwkSet where
+  jsonWebKeySet = _appJSONWebKeySet
+instance HasHttpManager UniWorX Manager where
+  httpManager = _appHttpManager
+instance HasAppSettings UniWorX where
+  appSettings = _appSettings'

src/Handler/Admin.hs

@@ -4,6 +4,8 @@ module Handler.Admin
 
 import Import
 
+import Handler.Utils
+
 import Handler.Admin.Test as Handler.Admin
 import Handler.Admin.ErrorMessage as Handler.Admin
 import Handler.Admin.StudyFeatures as Handler.Admin
@@ -13,8 +15,4 @@ getAdminR :: Handler Html
 getAdminR =
    siteLayoutMsg MsgAdminHeading $ do
       setTitleI MsgAdminHeading
-      [whamlet|
+      i18n MsgAdminPageEmpty
-        This shall become the Administrators' overview page.
-        Its current purpose is to provide links to some important admin functions
-      |]
-

src/Handler/Admin/Test.hs

@@ -38,7 +38,7 @@ emailTestForm :: AForm (HandlerFor UniWorX) (Email, MailContext)
 emailTestForm = (,)
             <$> areq emailField (fslI MsgMailTestFormEmail) Nothing
             <*> ( MailContext
-                  <$> (MailLanguages <$> areq (reorderField appLanguagesOpts) (fslI MsgMailTestFormLanguages) Nothing)
+                  <$> (Languages <$> areq (reorderField appLanguagesOpts) (fslI MsgMailTestFormLanguages) Nothing)
                   <*> (toMailDateTimeFormat
                         <$> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) Nothing
                         <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) Nothing
@@ -54,7 +54,7 @@ emailTestForm = (,)
 makeDemoForm :: Int -> Form (Int,Bool,Double)
 makeDemoForm n = identifyForm ("adminTestForm" :: Text) $ \html -> do
     (result, widget) <- flip (renderAForm FormStandard) html $ (,,)
-        <$> areq (minIntField n "Zahl") (fromString $ "Ganzzahl > " ++ show n) Nothing
+        <$> areq (minIntFieldI n ("Zahl" :: Text)) (fromString $ "Ganzzahl > " ++ show n) Nothing
         <*  aformSection MsgFormBehaviour
         <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True)
         <*> areq doubleField "Fliesskommazahl" Nothing
@@ -194,7 +194,7 @@ postAdminTestR = do
   siteLayout locallyDefinedPageHeading $ do
   -- defaultLayout $ do
     setTitle "Uni2work Admin Testpage"
-    $(widgetFile "adminTest")
+    $(i18nWidgetFile "admin-test")
 
     [whamlet|<h2>Formular Demonstration|]
     wrapForm formWidget FormSettings

src/Handler/Allocation/Application.hs

@@ -52,7 +52,7 @@ data ApplicationForm = ApplicationForm
   { afPriority      :: Maybe Natural
   , afField         :: Maybe StudyFeaturesId
   , afText          :: Maybe Text
-  , afFiles         :: Maybe (ConduitT () File Handler ())
+  , afFiles         :: Maybe FileUploads
   , afRatingVeto    :: Bool
   , afRatingPoints  :: Maybe ExamGrade
   , afRatingComment :: Maybe Text
@@ -291,8 +291,9 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
             , courseApplicationRatingTime         = guardOn rated now
             }
           let
-            sinkFile' file = do
+            sinkFile' (Right file) =
-              fId <- insert file
+              insert file >>= sinkFile' . Left
+            sinkFile' (Left fId) =
               insert_ $ CourseApplicationFile appId fId
           forM_ afFiles $ \afFiles' ->
             runConduit $ transPipe liftHandler afFiles' .| C.mapM_ sinkFile'
@@ -308,7 +309,7 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
             | afmApplicantEdit afMode -> do
               oldFiles <- Set.fromList . map (courseApplicationFileFile . entityVal) <$> selectList [CourseApplicationFileApplication ==. appId] []
               changes <- flip execStateT oldFiles . forM_ afFiles $ \afFiles' ->
-                let sinkFile' file = do
+                let sinkFile' (Right file) = do
                       oldFiles' <- lift . E.select . E.from $ \(courseApplicationFile `E.InnerJoin` file') -> do
                         E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file' E.^. FileId
                         E.where_ $ file' E.^. FileTitle E.==. E.val (fileTitle file)
@@ -326,7 +327,12 @@ editApplicationR maId uid cid mAppId afMode allowAction postAction = do
                             fId <- lift $ insert file
                             lift . insert_ $ CourseApplicationFile appId fId
                             modify $ Set.insert fId
-                 in runConduit $ transPipe liftHandler afFiles' .| C.mapM_ sinkFile'
+                    sinkFile' (Left fId)
+                      | fId `Set.member` oldFiles = modify $ Set.delete fId
+                      | otherwise = do
+                          lift . insert_ $ CourseApplicationFile appId fId
+                          modify $ Set.insert fId
+                in runConduit $ transPipe liftHandler afFiles' .| C.mapM_ sinkFile'
               deleteCascadeWhere [ FileId <-. Set.toList (oldFiles `Set.intersection` changes) ]
               return changes
             | otherwise

src/Handler/Common.hs

@@ -1,5 +1,8 @@
 -- | Common handler functions.
-module Handler.Common where
+module Handler.Common
+  ( getFaviconR
+  , getRobotsR
+  ) where
 
 import Data.FileEmbed (embedFile)
 import Import hiding (embedFile)

src/Handler/Corrections.hs

@@ -57,6 +57,8 @@ import qualified Control.Monad.State.Class as State
 
 import Data.Foldable (foldrM)
 
+import qualified Data.Conduit.List as C
+
 
 
 type CorrectionTableExpr  = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
@@ -215,6 +217,9 @@ colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ for
       _other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints)
   )
 
+colMaxPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData)))
+colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nCell . (\DBRow{ dbrOutput=(_, Entity _ Sheet{sheetType}, _, _, _, _) } -> sheetType)
+
 colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
 colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ fmap (cellAttrs <>~ [("style","width:60%")]) $ formCell id
   (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
@@ -274,6 +279,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
       , ( "rating"
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
         )
+      , ( "sheet-type"
+        , SortColumns $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _) -> 
+          [ SomeExprValue ((sheet E.^. SheetType) E.->. "type" :: E.SqlExpr (E.Value Value))
+          , SomeExprValue (((sheet E.^. SheetType) E.->. "grading" :: E.SqlExpr (E.Value Value)) E.->. "max" :: E.SqlExpr (E.Value Value))
+          , SomeExprValue (((sheet E.^. SheetType) E.->. "grading" :: E.SqlExpr (E.Value Value)) E.->. "passing" :: E.SqlExpr (E.Value Value))
+          ]
+        )
       , ( "israted"
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
         )
@@ -367,11 +379,22 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
               E.where_ $ (\f -> f user $ Set.singleton needle) $
                 E.mkContainsFilter (E.^. UserMatrikelnummer)
         )
-      -- , ( "pseudonym"
+      , ( "rating-visible"
-      --   , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(pseudonym) -> do
+        , FilterColumn $  \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
-      --       E.where_ $ querySheet table E.^. SheetId E.==. pseudonym E.^. SheetPseudonymSheet
+            Nothing   -> E.val True :: E.SqlExpr (E.Value Bool)
-      --       E.where_ $ E.mkContainsFilter -- DB only stores Pseudonym == Word24. Conversion not possible in DB.
+            Just True -> E.isJust    $ submission E.^. SubmissionRatingTime
-      --   )
+            Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
+        )
+      , ( "rating"
+        , FilterColumn $  \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) pts -> if
+            | Set.null pts -> E.val True :: E.SqlExpr (E.Value Bool)
+            | otherwise    -> E.maybe (E.val False :: E.SqlExpr (E.Value Bool)) (\p -> p `E.in_` E.valList (Set.toList pts)) (submission E.^. SubmissionRatingPoints)
+        )
+      , ( "comment"
+        , FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) comm -> case getLast (comm :: Last Text) of
+            Nothing     -> E.val True :: E.SqlExpr (E.Value Bool)
+            Just needle -> E.maybe (E.val False :: E.SqlExpr (E.Value Bool)) (E.isInfixOf $ E.val needle) (submission E.^. SubmissionRatingComment)
+        )
       ]
     , dbtFilterUI  = fromMaybe mempty dbtFilterUI
     , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@@ -605,7 +628,7 @@ postCorrectionsR = do
         , prismAForm (singletonFilter "term"   ) mPrev $ aopt (lift `hoistField` selectField termOptions)   (fslI MsgTerm)
         , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool)
         , Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField)                 (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
-        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField             (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant)             (fslI MsgRatingTime)
         ]
       courseOptions = runDB $ do
         courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
@@ -650,8 +673,8 @@ postCCorrectionsR tid ssh csh = do
         -- "pseudonym" TODO DB only stores Word24
         , Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
         , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
-        , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgHasCorrector)
+        , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
-        , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
         ]
       psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
   correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
@@ -681,8 +704,8 @@ postSSubsR tid ssh csh shn = do
         [ prismAForm (singletonFilter "user-name-email")      mPrev $ aopt textField (fslI MsgCourseMembers)
         , prismAForm (singletonFilter "user-matriclenumber")  mPrev $ aopt textField (fslI MsgMatrikelNr)
         , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
-        , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgHasCorrector)
+        , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
-        , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
         -- "pseudonym" TODO DB only stores Word24
         ]
       psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
@@ -714,13 +737,14 @@ postCorrectionR tid ssh csh shn cid = do
 
   results <- runDB $ correctionData tid ssh csh shn sub
 
+  MsgRenderer mr <- getMsgRenderer
   case results of
     [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do
       let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
           pointsForm = case sheetType of
             NotGraded  -> pure Nothing
             _otherwise -> aopt  (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
-                                (fslpI MsgRatingPoints "Punktezahl" & setTooltip sheetType)
+                                (fslpI MsgRatingPoints (mr MsgPointsPlaceholder) & setTooltip sheetType)
                                 (Just submissionRatingPoints)
 
       ((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,)
@@ -769,14 +793,13 @@ postCorrectionR tid ssh csh shn cid = do
       formResult uploadResult $ \fileUploads -> do
         uid <- requireAuthId
 
-        res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
+        res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| C.mapM (either get404 return) .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
         case res of
           Nothing  -> return () -- ErrorMessages are already added by msgSubmissionErrors
           (Just _) -> do
             addMessageI Success MsgRatingFilesUpdated
             redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
 
-      mr <- getMessageRender
       let sheetTypeDesc = mr sheetType
           heading = MsgCorrectionHead tid ssh csh shn cid
           headingWgt = [whamlet|
@@ -818,7 +841,7 @@ postCorrectionsUploadR = do
     FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
     FormSuccess files -> do
       uid <- requireAuthId
-      mbSubs <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkMultiSubmission uid True
+      mbSubs <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) files .| C.mapM (either get404 return) .| extractRatingsMsg .| sinkMultiSubmission uid True
       case mbSubs of
         Nothing -> return ()
         (Just subs)
@@ -868,9 +891,10 @@ postCorrectionsCreateR = do
             , optionInternalValue = sid
             , optionExternalValue = toPathPiece (cID :: CryptoUUIDSheet)
             }
+  MsgRenderer mr <- getMsgRenderer
   ((pseudonymRes, pseudonymWidget), pseudonymEncoding) <- runFormPost . renderAForm FormStandard $ (,)
     <$> areq (selectField sheetOptions) (fslI MsgPseudonymSheet) Nothing
-    <*> (textToList <$> areq textareaField (fslpI MsgCorrectionPseudonyms "Pseudonyme" & setTooltip MsgCorrectionPseudonymsTip) Nothing)
+    <*> (textToList <$> areq textareaField (fslpI MsgCorrectionPseudonyms (mr MsgPseudonyms) & setTooltip MsgCorrectionPseudonymsTip) Nothing)
 
   case pseudonymRes of
     FormMissing -> return ()
@@ -980,7 +1004,8 @@ postCorrectionsCreateR = do
         , formEncoding = pseudonymEncoding
         }
 
-  defaultLayout
+  siteLayoutMsg MsgCorrCreate $ do
+    setTitleI MsgCorrCreate
     $(widgetFile "corrections-create")
   where
     partitionEithers' :: [[Either a b]] -> ([[b]], [a])
@@ -1010,8 +1035,28 @@ postCorrectionsGradeR = do
         , colRated
         , colRatedField
         , colPointsField
+        , colMaxPointsField
         , colCommentField
         ] -- Continue here
+      filterUI = Just $ \mPrev -> mconcat
+        [ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse)
+        , prismAForm (singletonFilter "term"   ) mPrev $ aopt (lift `hoistField` selectField termOptions)   (fslI MsgTerm)
+        , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool)
+        , Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField)                 (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
+        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant)             (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "rating-visible" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingDone)
+        , prismAForm (singletonFilter "rating" . maybePrism _PathPiece) mPrev $ aopt (lift `hoistField` pointsField) (fslI MsgColumnRatingPoints)
+        , Map.singleton "comment" . maybeToList <$> aopt (lift `hoistField` textField) (fslI MsgRatingComment) (Just <$> listToMaybe =<< (Map.lookup "comment" =<< mPrev))
+        ]
+      courseOptions = runDB $ do
+        courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
+        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
+      termOptions = runDB $ do
+        courses <- selectList [] [Asc CourseTerm]      >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
+        optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
+      schoolOptions = runDB $ do
+        courses <- selectList [] [Asc CourseSchool]    >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
+        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
       psValidator = def
         & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData))
       unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
@@ -1020,7 +1065,7 @@ postCorrectionsGradeR = do
         void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
         return i
 
-  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns mempty psValidator dbtProj' $ def
+  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI psValidator dbtProj' $ def
     { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
     }
 
@@ -1045,7 +1090,8 @@ postCorrectionsGradeR = do
           content = Right $(widgetFile "messages/correctionsUploaded")
       unless (null subs') $ addMessageModal Success trigger content
 
-  defaultLayout $
+  siteLayoutMsg MsgCorrectionsGrade $ do
+    setTitleI MsgCorrectionsGrade
     $(widgetFile "corrections-grade")
 
 

src/Handler/Course/Edit.hs

@@ -256,7 +256,6 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
 
             optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template)
 
-    -- TODO: internationalization
     -- let autoUnzipInfo = [|Entpackt hochgeladene Zip-Dateien (*.zip) automatisch und fügt den Inhalt dem Stamm-Verzeichnis der Abgabe hinzu. TODO|]
 
     (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
@@ -267,9 +266,9 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
             & setTooltip MsgCourseShorthandUnique)                      (cfShort      <$> template)
       <*> areq (schoolFieldFor userSchools)   (fslI MsgCourseSchool)    (cfSchool     <$> template)
       <*> areq termsField                     (fslI MsgCourseSemester)  (cfTerm       <$> template)
-      <*> aopt htmlField (fslpI MsgCourseDescription "Bitte mindestens die Modulbeschreibung angeben"
+      <*> aopt htmlField (fslpI MsgCourseDescription (mr MsgCourseDescriptionPlaceholder)
                          & setTooltip MsgCourseDescriptionTip)          (cfDesc       <$> template)
-      <*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal "Optionale externe URL")
+      <*> aopt (urlField & cfStrip) (fslpI MsgCourseHomepageExternal (mr MsgCourseHomepageExternalPlaceholder))
                                                                         (cfLink       <$> template)
       <*> apopt checkBoxField  (fslI  MsgMaterialFree)                   (cfMatFree    <$> template)
       <*  aformSection MsgCourseFormSectionRegistration

src/Handler/Course/LecturerInvite.hs

@@ -66,7 +66,7 @@ lecturerInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ (InvDBDataLecturer mlType, _) _ = hoistAForm liftHandler $ toJunction <$> case mlType of

src/Handler/Course/List.hs

@@ -176,7 +176,7 @@ makeCourseTable whereClause colChoices psValidator = do
       , Just  $ prismAForm (singletonFilter "lecturer") mPrev $ aopt textField (fslI MsgCourseLecturer)
       , Just  $ prismAForm (singletonFilter "search") mPrev $ aopt textField (fslI MsgCourseFilterSearch)
       , Just  $ prismAForm (singletonFilter "openregistration" . maybePrism _PathPiece) mPrev $ fmap (\x -> if isJust x && not (fromJust x) then Nothing else x) . aopt checkBoxField (fslI MsgCourseRegisterOpen)
-      , muid $> prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt boolField (fslI MsgCourseFilterRegistered))
+      , muid $> prismAForm (singletonFilter "registered" . maybePrism _PathPiece) mPrev (aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgCourseFilterRegistered))
       ]
     , dbtStyle = def
       { dbsFilterLayout = defaultDBSFilterLayout

src/Handler/Course/ParticipantInvite.hs

@@ -83,7 +83,7 @@ participantInvitationConfig = InvitationConfig{..}
     invitationHeading     (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseParticipantInviteHeading $ CI.original courseName
     invitationExplanation  _                    _ = return [ihamlet|_{SomeMessage MsgCourseParticipantInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm (Entity _ Course{..}) _ uid = hoistAForm lift . wFormToAForm $ do

src/Handler/Course/Register.hs

@@ -42,7 +42,7 @@ instance Button UniWorX ButtonCourseRegister where
 data CourseRegisterForm = CourseRegisterForm
   { crfStudyFeatures    :: Maybe StudyFeaturesId
   , crfApplicationText  :: Maybe Text
-  , crfApplicationFiles :: Maybe (ConduitT () File Handler ())
+  , crfApplicationFiles :: Maybe FileUploads
   }
 
 courseRegisterForm :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Course -> m (AForm Handler CourseRegisterForm, ButtonCourseRegister)
@@ -195,7 +195,7 @@ postCRegisterR tid ssh csh = do
             whenIsJust appRes $ 
               audit . TransactionCourseApplicationEdit cid uid 
             whenIsJust ((,) <$> appRes <*> crfApplicationFiles) $ \(appId, fSource) -> do
-              runConduit $ transPipe liftHandler fSource .| C.mapM_ (\f -> insert f >>= insert_ . CourseApplicationFile appId)
+              runConduit $ transPipe liftHandler fSource .| C.mapM_ (insert_ . CourseApplicationFile appId <=< either return insert)
             return appRes
         | otherwise
         = return $ Just ()

src/Handler/CryptoIDDispatch.hs

@@ -66,7 +66,7 @@ instance (CryptoRoute ciphertext plaintext, Dispatch ciphertext ps) => Dispatch
   
 
 getCryptoUUIDDispatchR :: UUID -> Handler ()
-getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith found302)
+getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectAccessWith movedPermanently301)
   where
     p :: Proxy '[ SubmissionId
                 , UserId
@@ -74,7 +74,7 @@ getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith
     p = Proxy
 
 getCryptoFileNameDispatchR :: CI FilePath -> Handler ()
-getCryptoFileNameDispatchR path = dispatchID p path >>= maybe notFound (redirectWith found302)
+getCryptoFileNameDispatchR path = dispatchID p path >>= maybe notFound (redirectAccessWith movedPermanently301)
   where
     p :: Proxy '[ SubmissionId ] 
     p = Proxy

src/Handler/Exam/CorrectorInvite.hs

@@ -67,7 +67,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInviteHeading examName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionExamCorrector, ())

src/Handler/Exam/RegistrationInvite.hs

@@ -77,7 +77,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamRegistrationInviteHeading examName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamRegistrationInviteExplanation}|]
     invitationTokenConfig _ (InvDBDataExamRegistration{..}, _) = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       let itExpiresAt = Just $ Just invDBExamRegistrationDeadline
           itAddAuth
             | not invDBExamRegistrationCourseRegister

src/Handler/ExamOffice/Exam.hs

@@ -369,7 +369,7 @@ postEGradesR tid ssh csh examn = do
             , fltrStudyDegreeUI
             , fltrStudyFeaturesSemesterUI
             , fltrExamResultPointsUI examShowGrades
-            , \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgExamUserSynchronised)
+            , \mPrev -> prismAForm (singletonFilter "is-synced" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgExamUserSynchronised)
             ]
           dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
           dbtParams = DBParamsForm

src/Handler/ExamOffice/Users.hs

@@ -67,7 +67,7 @@ examOfficeUserInvitationConfig = InvitationConfig{..}
       return . SomeMessage $ MsgExamOfficeUserInviteHeading userDisplayName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamOfficeUserInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       let itExpiresAt = Nothing
           itStartsAt = Nothing
           itAddAuth = Nothing

src/Handler/Home.hs

@@ -32,7 +32,7 @@ homeUpcomingSheets uid = do
                                 , E.SqlExpr (E.Value SchoolId)
                                 , E.SqlExpr (E.Value CourseShorthand)
                                 , E.SqlExpr (E.Value SheetName)
-                                , E.SqlExpr (E.Value UTCTime)
+                                , E.SqlExpr (E.Value (Maybe UTCTime))
                                 , E.SqlExpr (E.Value (Maybe SubmissionId)))
       tableData ((participant `E.InnerJoin` course `E.InnerJoin` sheet) `E.LeftOuterJoin` (submission `E.InnerJoin` subuser)) = do
         E.on $ submission E.?. SubmissionId    E.==. subuser      E.?. SubmissionUserSubmission
@@ -41,7 +41,7 @@ homeUpcomingSheets uid = do
         E.on $ course     E.^. CourseId        E.==. sheet        E.^. SheetCourse
         E.on $ course     E.^. CourseId        E.==. participant  E.^. CourseParticipantCourse
         E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
-            E.&&. sheet E.^. SheetActiveTo E.>=. E.val cTime
+            E.&&. E.maybe E.true (E.>=. E.val cTime) (sheet E.^. SheetActiveTo)
         return
           ( course  E.^. CourseTerm
           , course  E.^. CourseSchool
@@ -55,7 +55,7 @@ homeUpcomingSheets uid = do
                                              , E.Value SchoolId
                                              , E.Value CourseShorthand
                                              , E.Value SheetName
-                                             , E.Value UTCTime
+                                             , E.Value (Maybe UTCTime)
                                              , E.Value (Maybe SubmissionId)
                                              ))
                                       (DBCell Handler ())
@@ -70,8 +70,8 @@ homeUpcomingSheets uid = do
             anchorCell (CourseR tid ssh csh CShowR) csh
         , sortable (Just "sheet")  (i18nCell MsgSheet)  $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) } ->
             anchorCell (CSheetR tid ssh csh shn SShowR) shn
-        , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
+        , sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value mDeadline, _) } ->
-            cell $ formatTime SelFormatDateTime deadline >>= toWidget
+            maybe mempty (cell . formatTimeW SelFormatDateTime) mDeadline
         , sortable (Just "done")   (i18nCell MsgDone)   $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } ->
             case mbsid of
               Nothing    -> cell $ do

src/Handler/Info.hs

@@ -2,6 +2,10 @@ module Handler.Info where
 
 import Import
 import Handler.Utils
+import Handler.Info.TH
+
+import qualified Data.Map as Map
+import qualified Data.CaseInsensitive as CI
 
 import Development.GitRev
 
@@ -67,3 +71,18 @@ getInfoLecturerR =
       if currentTime > expiryTime
         then mempty
         else toWidget [whamlet| ^{iconTooltip tooltipNew (Just IconNew) False} |]
+
+getGlossaryR :: Handler Html
+getGlossaryR =
+  siteLayoutMsg' MsgGlossaryTitle $ do
+    setTitleI MsgGlossaryTitle
+    MsgRenderer mr <- getMsgRenderer
+    let
+      entries' = sortOn (CI.mk . view _2) $ do
+        (k, v) <- Map.toList entries
+        msg <- maybeToList $ Map.lookup k msgMap
+        return (k, mr msg, v)
+    $(widgetFile "glossary")
+  where
+    entries = $(i18nWidgetFiles "glossary")
+    msgMap = $(glossaryTerms "glossary")

src/Handler/Info/TH.hs

@@ -0,0 +1,23 @@
+module Handler.Info.TH
+  ( glossaryTerms
+  ) where
+
+import Import
+import Handler.Utils.I18n
+
+import Language.Haskell.TH
+
+import qualified Data.Char as Char
+
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as Text
+
+
+glossaryTerms :: FilePath -> Q Exp
+glossaryTerms basename = do
+  translationsAvailable <- i18nWidgetFilesAvailable' basename
+  let terms = Map.mapWithKey (\k _ -> "Msg" <> unPathPiece k) translationsAvailable
+  [e|Map.fromList $(listE . map (\(int, msg) -> tupE [litE . stringL $ repack int, conE $ mkName msg]) $ Map.toList terms)|]
+  where
+    unPathPiece :: Text -> String
+    unPathPiece = repack . mconcat . map (over _head Char.toUpper) . Text.splitOn "-"

src/Handler/Metrics.hs

@@ -0,0 +1,45 @@
+module Handler.Metrics
+  ( getMetricsR
+  ) where
+
+import Import hiding (Info)
+
+import Prometheus
+import qualified Network.Wai.Middleware.Prometheus as Prometheus
+
+import qualified Data.Text as Text
+import qualified Data.HashSet as HashSet
+
+
+getMetricsR :: Handler TypedContent
+getMetricsR = selectRep $ do
+  provideRep (sendWaiApplication Prometheus.metricsApp :: Handler Text)
+  provideRep metricsHtml
+  provideRep $ collectMetrics >>= returnJson
+  where
+    metricsHtml :: Handler Html
+    metricsHtml = do
+      samples <- collectMetrics
+
+      metricsToken <- runMaybeT . hoist runDB $ do
+        uid <- MaybeT maybeAuthId
+        guardM . lift . existsBy $ UniqueUserGroupMember UserGroupMetrics uid
+
+        encodeToken =<< bearerToken (Left $ toJSON UserGroupMetrics) (Just $ HashSet.singleton MetricsR) Nothing (Just Nothing) Nothing
+  
+      defaultLayout $ do
+        setTitleI MsgTitleMetrics
+        $(widgetFile "metrics")
+
+    metricBasename base sName
+      | Just suffix <- Text.stripPrefix base sName
+      = if | Just suffix' <- Text.stripPrefix "_" suffix
+             -> suffix'
+           | otherwise
+             -> suffix
+      | otherwise
+      = sName
+    getLabels = nub . concatMap (\(Sample _ lPairs _) -> lPairs ^.. folded . _1)
+    singleSample base [Sample sName lPairs sValue]
+      | sName == base = Just (lPairs, sValue)
+    singleSample _ _ = Nothing

src/Handler/Profile.hs

@@ -5,6 +5,7 @@ module Handler.Profile
   , getUserNotificationR, postUserNotificationR
   , getSetDisplayEmailR, postSetDisplayEmailR
   , getCsvOptionsR, postCsvOptionsR
+  , postLangR
   ) where
 
 import Import
@@ -22,6 +23,8 @@ import qualified Data.Set as Set
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Utils as E
 -- import           Database.Esqueleto      ((^.))
+import qualified Data.Text as Text
+import Data.List (inits)
 
 import qualified Data.CaseInsensitive as CI
 
@@ -76,15 +79,16 @@ instance RenderMessage UniWorX NotificationTriggerKind where
 
 makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
 makeSettingForm template html = do
+    MsgRenderer mr <- getMsgRenderer
     (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
         <$  aformSection MsgFormPersonalAppearance
         <*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template)
         <*> areq (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template)
         <*  aformSection MsgFormCosmetics
-        <*> areq (natFieldI $ MsgNatField "Favoriten")
+        <*> areq (natFieldI MsgFavouritesNotNatural)
-            (fslpI MsgFavourites "Anzahl Favoriten" & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template)
+            (fslpI MsgFavourites (mr MsgFavouritesPlaceholder) & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template)
-        <*> areq (natFieldI $ MsgNatField "Favoriten-Semester")
+        <*> areq (natFieldI MsgFavouritesSemestersNotNatural)
-            (fslpI MsgFavouriteSemesters "Anzahl Semester") (stgMaxFavouriteTerms <$> template)
+            (fslpI MsgFavouriteSemesters (mr MsgFavouritesSemestersPlaceholder)) (stgMaxFavouriteTerms <$> template)
         <*> areq (selectField . return $ mkOptionList themeList)
             (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
         <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
@@ -315,7 +319,7 @@ postProfileR = do
   tResetTime <- traverse (formatTime SelFormatDateTime) userTokensIssuedAfter
 
   siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do
-    setTitle . toHtml $ "Profil " <> userIdent
+    setTitleI MsgProfileTitle
     let settingsForm =
           wrapForm formWidget FormSettings
             { formMethod = POST
@@ -366,10 +370,11 @@ makeProfileData (Entity uid User{..}) = do
   submissionTable      <- mkSubmissionTable           uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen
   submissionGroupTable <- mkSubmissionGroupTable      uid -- Tabelle mit allen Abgabegruppen
   correctionsTable     <- mkCorrectionsTable          uid -- Tabelle mit allen Korrektor-Aufgaben
-  let examTable        = [whamlet|Prüfungen werden hier momentan leider noch nicht unterstützt.|]
+  let examTable        = [whamlet|_{MsgPersonalInfoExamAchievementsWip}|]
-  let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
+  let ownTutorialTable = [whamlet|_{MsgPersonalInfoOwnTutorialsWip}|]
-  let tutorialTable    = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
+  let tutorialTable    = [whamlet|_{MsgPersonalInfoTutorialsWip}|]
   lastLogin <- traverse (formatTime SelFormatDateTime) userLastAuthentication
+  let profileRemarks = $(i18nWidgetFile "profile-remarks")
   return $(widgetFile "profileData")
 
 
@@ -837,3 +842,18 @@ postCsvOptionsR = do
       , formEncoding = optionsEnctype
       , formAttrs = [ asyncSubmitAttr | isModal ]
       }
+
+postLangR :: Handler ()
+postLangR = do
+  ((langRes, _), _) <- runFormPost $ identifyForm FIDLanguage langForm
+
+  formResult langRes $ \(lang, route) -> do
+    lang' <- runDB . updateUserLanguage $ Just lang
+    
+    app <- getYesod
+    let mr | Just lang'' <- lang' = renderMessage app . map (Text.intercalate "-") . reverse . inits $ Text.splitOn "-" lang''
+           | otherwise = renderMessage app []
+    addMessage Success . toHtml $ mr MsgLanguageChanged
+    redirect route
+
+  invalidArgs ["Language form required"]

src/Handler/Sheet.hs

@@ -55,6 +55,8 @@ import Text.Hamlet (ihamlet)
 
 import System.FilePath (addExtension)
 
+import Data.Time.Clock.System (systemEpochDay)
+
 
 {-
   * Implement Handlers
@@ -62,22 +64,38 @@ import System.FilePath (addExtension)
   * Implement Access in Foundation
 -}
 
+type Loads = Map (Either UserEmail UserId) (InvitationData SheetCorrector)
+
 data SheetForm = SheetForm
       { sfName         :: SheetName
+      , sfDescription  :: Maybe Html
+      , sfSheetF, sfHintF, sfSolutionF, sfMarkingF :: Maybe (ConduitT () (Either FileId File) Handler ())
       , sfVisibleFrom  :: Maybe UTCTime
-      , sfActiveFrom   :: UTCTime
+      , sfActiveFrom   :: Maybe UTCTime
-      , sfActiveTo     :: UTCTime
+      , sfActiveTo     :: Maybe UTCTime
       , sfHintFrom     :: Maybe UTCTime
       , sfSolutionFrom :: Maybe UTCTime
-      , sfSheetF, sfHintF, sfSolutionF, sfMarkingF :: Maybe (ConduitT () (Either FileId File) Handler ())
       , sfType         :: SheetType
       , sfGrouping     :: SheetGroup
       , sfSubmissionMode :: SubmissionMode
-      , sfDescription  :: Maybe Html
+      , sfAutoDistribute :: Bool
       , sfMarkingText  :: Maybe Html
+      , sfCorrectors   :: Loads
       -- Keine SheetId im Formular!
       }
 
+data ButtonGeneratePseudonym = BtnGenerate
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe ButtonGeneratePseudonym
+instance Finite ButtonGeneratePseudonym
+
+nullaryPathPiece ''ButtonGeneratePseudonym (camelToPathPiece' 1)
+
+instance Button UniWorX ButtonGeneratePseudonym where
+  btnLabel BtnGenerate = [whamlet|_{MsgSheetGeneratePseudonym}|]
+  btnClasses BtnGenerate = [BCIsButton, BCDefault]
+
+
 getFtIdMap :: Key Sheet -> DB (SheetFileType -> Set FileId)
 getFtIdMap sId = do
   allfIds <- E.select . E.from $ \(sheetFile `E.InnerJoin` file) -> do
@@ -91,40 +109,41 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
     oldFileIds <- (return.) <$> case msId of
       Nothing    -> return $ partitionFileType mempty
       (Just sId) -> liftHandler $ runDB $ getFtIdMap sId
-    mr <- getMsgRenderer
+    mr'@(MsgRenderer mr) <- getMsgRenderer
     ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
     (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
       <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName)         (sfName        <$> template)
-      <* aformSection MsgSheetFormTimes
+      <*> aopt htmlField      (fslpI MsgSheetDescription "Html") (sfDescription <$> template)
-      <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
-            & setTooltip MsgSheetVisibleFromTip)
-                                                              ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
-      <*> areq utcTimeField   (fslI MsgSheetActiveFrom
-            & setTooltip MsgSheetActiveFromTip)
-                                                              (sfActiveFrom   <$> template)
-      <*> areq utcTimeField   (fslI MsgSheetActiveTo)         (sfActiveTo     <$> template)
-      <*> aopt utcTimeField   (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren"
-            & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
-      <*> aopt utcTimeField   (fslpI MsgSheetSolutionFrom  "Datum, sonst nur für Korrektoren"
-            & setTooltip MsgSheetSolutionFromTip)             (sfSolutionFrom <$> template)
       <* aformSection MsgSheetFormFiles
       <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetHint)     (fslI MsgSheetHint)      (sfHintF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarkingFiles
             & setTooltip MsgSheetMarkingTip)                  (sfMarkingF <$> template)
+      <* aformSection MsgSheetFormTimes
+      <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
+            & setTooltip MsgSheetVisibleFromTip)
+                                                              ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
+      <*> aopt utcTimeField   (fslI MsgSheetActiveFrom
+            & setTooltip MsgSheetActiveFromTip)
+                                                              (sfActiveFrom   <$> template)
+      <*> aopt utcTimeField   (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template)
+      <*> aopt utcTimeField   (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder)
+            & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
+      <*> aopt utcTimeField   (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder)
+            & setTooltip MsgSheetSolutionFromTip)             (sfSolutionFrom <$> template)
       <* aformSection MsgSheetFormType
       <*> sheetTypeAFormReq   (fslI MsgSheetType
             & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus, MsgSheetTypeInfoInformational, MsgSheetTypeInfoNotGraded]))
                                                           (sfType        <$> template)
       <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)
       <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction))
-      <*> aopt htmlField      (fslpI MsgSheetDescription "Html")
+      <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
-                                                          (sfDescription <$> template)
       <*> aopt htmlField    (fslpI MsgSheetMarking "Html") (sfMarkingText <$> template)
+      <*> correctorForm (fromMaybe mempty $ sfCorrectors <$> template)
     return $ case result of
       FormSuccess sheetResult
-        | errorMsgs <- validateSheet mr sheetResult
+        | errorMsgs <- validateSheet mr' sheetResult
         , not $ null errorMsgs ->
             (FormFailure errorMsgs, widget)
       _ -> (result, widget)
@@ -132,10 +151,10 @@ makeSheetForm msId template = identifyForm FIDsheet $ \html -> do
     validateSheet :: MsgRenderer -> SheetForm -> [Text]
     validateSheet (MsgRenderer {..}) (SheetForm{..}) =
       [ msg | (False, msg) <-
-        [ (      sfVisibleFrom  <=       Just sfActiveFrom  , render MsgSheetErrVisibility)
+        [ ( NTop sfVisibleFrom  <= NTop sfActiveFrom  , render MsgSheetErrVisibility)
-        , (      sfActiveFrom   <=            sfActiveTo    , render MsgSheetErrDeadlineEarly)
+        , ( NTop sfActiveFrom   <= NTop sfActiveTo    , render MsgSheetErrDeadlineEarly)
-        , ( NTop sfHintFrom     >= NTop (Just sfActiveFrom) , render MsgSheetErrHintEarly)
+        , ( NTop sfHintFrom     >= NTop sfActiveFrom  , render MsgSheetErrHintEarly)
-        , ( NTop sfSolutionFrom >= NTop (Just sfActiveTo)   , render MsgSheetErrSolutionEarly)
+        , ( NTop sfSolutionFrom >= NTop sfActiveTo    , render MsgSheetErrSolutionEarly)
       ] ]
 
 
@@ -216,9 +235,9 @@ getSheetListR tid ssh csh = do
                               else spacerCell
               ] id & cellAttrs <>~ [("class","list--inline list--space-separated")]
       , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
-          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> dateTimeCell sheetActiveFrom
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveFrom
       , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
-          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> dateTimeCell sheetActiveTo
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> maybe mempty dateTimeCell sheetActiveTo
       , sortable Nothing (i18nCell MsgSheetType)
           $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _, _)} -> i18nCell sheetType
       , sortable Nothing (i18nCell MsgSubmission)
@@ -231,26 +250,34 @@ getSheetListR tid ssh csh = do
                       return $ CSubmissionR tid ssh csh sheetName cid' SubShowR
                 in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{cid2}|])
       , sortable (Just "rating") (i18nCell MsgRating)
-          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub,_)} ->
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub,_)} -> 
             let stats = sheetTypeSum sheetType in -- for statistics over all shown rows
             case mbSub of
               Nothing -> cellTell mempty $ stats Nothing
               (Just (Entity sid sub@Submission{..})) ->
-                let mkCid = encrypt sid
+                let
-                    mkRoute = do
+                    mkRoute :: (MonadHandler m, HandlerSite m ~ UniWorX) => m (Route UniWorX)
-                      cid' <- mkCid
+                    mkRoute = liftHandler $ do
+                      cid' <- encrypt sid
                       return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
                     mTuple mA mB = (,) <$> mA <*> mB -- Hamlet does not support enough haskell-syntax for this
                     acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
-                in cellTell acell $ stats submissionRatingPoints
+                    tellStats = do
+                      r <- mkRoute
+                      showRating <- hasReadAccessTo r
+                      tell . stats $ bool Nothing submissionRatingPoints showRating
+                in acell & cellContents %~ (<* tellStats)
 
       , sortable Nothing -- (Just "percent")
                         (i18nCell MsgRatingPercent)
-          $ \DBRow{dbrOutput=(Entity _ Sheet{sheetType=sType}, _, mbSub,_)} -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{sheetType=sType, sheetName}, _, mbSub,_)} -> case mbSub of
-              (Just (Entity _ Submission{submissionRatingPoints=Just sPoints})) ->
+              (Just (Entity sid Submission{submissionRatingPoints=Just sPoints})) ->
                 case preview (_grading . _maxPoints) sType of
                   Just maxPoints
-                    | maxPoints /= 0 -> textCell $ textPercent sPoints maxPoints
+                    | maxPoints /= 0 -> cell $ do
+                        cID <- encrypt sid
+                        showRating <- hasReadAccessTo $ CSubmissionR tid ssh csh sheetName cID CorrectionR
+                        bool (return ()) (toWidget . toMessage $ textPercent sPoints maxPoints) showRating
                   _other -> mempty
               _other -> mempty
       ]
@@ -319,17 +346,6 @@ getSheetListR tid ssh csh = do
   defaultLayout $ do
     $(widgetFile "sheetList")
 
-data ButtonGeneratePseudonym = BtnGenerate
-  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
-instance Universe ButtonGeneratePseudonym
-instance Finite ButtonGeneratePseudonym
-
-nullaryPathPiece ''ButtonGeneratePseudonym (camelToPathPiece' 1)
-
-instance Button UniWorX ButtonGeneratePseudonym where
-  btnLabel BtnGenerate = [whamlet|_{MsgSheetGeneratePseudonym}|]
-  btnClasses BtnGenerate = [BCIsButton, BCDefault]
-
 -- Show single sheet
 getSShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSShowR tid ssh csh shn = do
@@ -422,8 +438,9 @@ getSShowR tid ssh csh shn = do
     setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn
     let zipLink = CSheetR tid ssh csh shn SArchiveR
         visibleFrom =     visibleUTCTime SelFormatDateTime <$> sheetVisibleFrom  sheet
-    sheetFrom     <-           formatTime SelFormatDateTime  $  sheetActiveFrom   sheet
+        hasSubmission = classifySubmissionMode (sheetSubmissionMode sheet) /= SubmissionModeNone
-    sheetTo       <-           formatTime SelFormatDateTime  $  sheetActiveTo     sheet
+    sheetFrom     <- traverse (formatTime SelFormatDateTime) $  sheetActiveFrom   sheet
+    sheetTo       <- traverse (formatTime SelFormatDateTime) $  sheetActiveTo     sheet
     hintsFrom     <- traverse (formatTime SelFormatDateTime) $  sheetHintFrom     sheet
     solutionFrom  <- traverse (formatTime SelFormatDateTime) $  sheetSolutionFrom sheet
     markingText   <- runMaybeT $ assertM_ (Authorized ==) (evalAccessCorrector tid ssh csh) >> hoistMaybe (sheetMarkingText sheet)
@@ -480,7 +497,8 @@ getSheetNewR tid ssh csh = do
         (FormSuccess (Just shn)) -> E.where_ $ sheet E.^. SheetName E.==. E.val shn
         -- (FormFailure msgs) -> -- not in MonadHandler anymore -- forM_ msgs (addMessage Error . toHtml)
         _other -> return ()
-  lastSheets <- runDB $ E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
+  (lastSheets, loads) <- runDB $ do
+    lSheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
       E.on     $ course E.^. CourseId E.==. sheet E.^. SheetCourse
       E.where_ $ course E.^. CourseTerm      E.==. E.val tid
           E.&&.  course E.^. CourseSchool    E.==. E.val ssh
@@ -493,27 +511,35 @@ getSheetNewR tid ssh csh = do
       -- E.orderBy [E.desc lastSheetEdit, E.desc (sheet E.^. SheetActiveFrom)]
       E.orderBy [E.desc (sheet E.^. SheetActiveFrom)]
       E.limit 1
-      return sheet
+      let firstEdit = E.sub_select . E.from $ \sheetEdit -> do
+            E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
+            return . E.min_ $ sheetEdit E.^. SheetEditTime
+      return (sheet, firstEdit)
+    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+    loads <- defaultLoads cid
+    return (lSheets, loads)
   now <- liftIO getCurrentTime
   let template = case lastSheets of
-        ((Entity {entityVal=Sheet{..}}):_)  ->
+        ((Entity {entityVal=Sheet{..}}, E.Value fEdit):_)  ->
-          let addTime = addWeeks $ max 1 $ weeksToAdd sheetActiveTo now
+          let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now
           in Just $ SheetForm
-            { sfName         = stepTextCounterCI sheetName
+            { sfName           = stepTextCounterCI sheetName
-            , sfDescription  = sheetDescription
+            , sfDescription    = sheetDescription
-            , sfType         = sheetType
+            , sfType           = sheetType
-            , sfGrouping     = sheetGrouping
+            , sfGrouping       = sheetGrouping
-            , sfVisibleFrom  = addTime <$> sheetVisibleFrom
+            , sfVisibleFrom    = addTime <$> sheetVisibleFrom
-            , sfActiveFrom   = addTime     sheetActiveFrom
+            , sfActiveFrom     = addTime <$> sheetActiveFrom
-            , sfActiveTo     = addTime     sheetActiveTo
+            , sfActiveTo       = addTime <$> sheetActiveTo
             , sfSubmissionMode = sheetSubmissionMode
-            , sfSheetF       = Nothing
+            , sfSheetF         = Nothing
-            , sfHintFrom     = addTime <$> sheetHintFrom
+            , sfHintFrom       = addTime <$> sheetHintFrom
-            , sfHintF        = Nothing
+            , sfHintF          = Nothing
-            , sfSolutionFrom = addTime <$> sheetSolutionFrom
+            , sfSolutionFrom   = addTime <$> sheetSolutionFrom
-            , sfSolutionF    = Nothing
+            , sfSolutionF      = Nothing
-            , sfMarkingF     = Nothing
+            , sfMarkingF       = Nothing
-            , sfMarkingText  = sheetMarkingText
+            , sfMarkingText    = sheetMarkingText
+            , sfAutoDistribute = sheetAutoDistribute
+            , sfCorrectors     = loads
             }
         _other -> Nothing
   let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
@@ -526,44 +552,49 @@ postSheetNewR = getSheetNewR
 
 getSEditR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSEditR tid ssh csh shn = do
-  (Entity sid Sheet{..}, sheetFileIds) <- runDB $ do
+  (Entity sid Sheet{..}, sheetFileIds, currentLoads) <- runDB $ do
-    ent <- fetchSheet tid ssh csh shn
+    ent@(Entity sid _) <- fetchSheet tid ssh csh shn
     fti <- getFtIdMap $ entityKey ent
-    return (ent, fti)
+    cLoads <- Map.union
+      <$> fmap (foldMap $ \(Entity _ SheetCorrector{..}) -> Map.singleton (Right sheetCorrectorUser) (InvDBDataSheetCorrector sheetCorrectorLoad sheetCorrectorState, InvTokenDataSheetCorrector)) (selectList [ SheetCorrectorSheet ==. sid ] [])
+      <*> fmap (fmap (, InvTokenDataSheetCorrector) . Map.mapKeysMonotonic Left) (sourceInvitationsF sid)
+    return (ent, fti, cLoads)
   let template = Just $ SheetForm
-        { sfName         = sheetName
+        { sfName           = sheetName
-        , sfDescription  = sheetDescription
+        , sfDescription    = sheetDescription
-        , sfType         = sheetType
+        , sfType           = sheetType
-        , sfGrouping     = sheetGrouping
+        , sfGrouping       = sheetGrouping
-        , sfVisibleFrom  = sheetVisibleFrom
+        , sfVisibleFrom    = sheetVisibleFrom
-        , sfActiveFrom   = sheetActiveFrom
+        , sfActiveFrom     = sheetActiveFrom
-        , sfActiveTo     = sheetActiveTo
+        , sfActiveTo       = sheetActiveTo
         , sfSubmissionMode = sheetSubmissionMode
-        , sfSheetF       = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetExercise
+        , sfSheetF         = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetExercise
-        , sfHintFrom     = sheetHintFrom
+        , sfHintFrom       = sheetHintFrom
-        , sfHintF        = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetHint
+        , sfHintF          = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetHint
-        , sfSolutionFrom = sheetSolutionFrom
+        , sfSolutionFrom   = sheetSolutionFrom
-        , sfSolutionF    = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetSolution
+        , sfSolutionF      = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetSolution
-        , sfMarkingF     = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetMarking
+        , sfMarkingF       = Just . yieldMany . map Left . Set.elems $ sheetFileIds SheetMarking
-        , sfMarkingText  = sheetMarkingText
+        , sfMarkingText    = sheetMarkingText
+        , sfAutoDistribute = sheetAutoDistribute
+        , sfCorrectors     = currentLoads
         }
+
   let action = uniqueReplace sid -- More specific error message for edit old sheet could go here by using myReplaceUnique instead
   handleSheetEdit tid ssh csh (Just sid) template action
 
 postSEditR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 postSEditR = getSEditR
 
-handleSheetEdit :: TermId -> SchoolId -> CourseShorthand -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
+handleSheetEdit :: TermId -> SchoolId -> CourseShorthand -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodJobDB UniWorX (Maybe SheetId)) -> Handler Html
 handleSheetEdit tid ssh csh msId template dbAction = do
   let mbshn  = sfName <$> template
   aid  <- requireAuthId
+  cid <- runDB $ getKeyBy404 $ TermSchoolCourseShort tid ssh csh
   ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm msId template
   case res of
     (FormSuccess SheetForm{..}) -> do
-      saveOkay <- runDB $ do
+      saveOkay <- runDBJobs $ do
         actTime <- liftIO getCurrentTime
-        cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-        oldAutoDistribute <- fmap sheetAutoDistribute . join <$> traverse get msId
         let newSheet = Sheet
               { sheetCourse         = cid
               , sheetName           = sfName
@@ -577,7 +608,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do
               , sheetHintFrom       = sfHintFrom
               , sheetSolutionFrom   = sfSolutionFrom
               , sheetSubmissionMode = sfSubmissionMode
-              , sheetAutoDistribute = fromMaybe False oldAutoDistribute
+              , sheetAutoDistribute = sfAutoDistribute
               }
         mbsid <- dbAction newSheet
         case mbsid of
@@ -590,22 +621,36 @@ handleSheetEdit tid ssh csh msId template dbAction = do
             insert_ $ SheetEdit aid actTime sid
             addMessageI Success $ MsgSheetEditOk tid ssh csh sfName
             -- Sanity checks generating warnings only, but not errors!
-            warnTermDays tid $ Map.fromList [ (date,name) | (Just date, name) <-
+            hoist lift . warnTermDays tid $ Map.fromList [ (date,name) | (Just date, name) <-
                 [ (sfVisibleFrom,     MsgSheetVisibleFrom)
-                , (Just sfActiveFrom, MsgSheetActiveFrom)
+                , (sfActiveFrom,      MsgSheetActiveFrom)
-                , (Just sfActiveTo,   MsgSheetActiveTo)
+                , (sfActiveTo,        MsgSheetActiveTo)
                 , (sfHintFrom,        MsgSheetSolutionFromTip)
                 , (sfSolutionFrom,    MsgSheetSolutionFrom)
                 ] ]
+
+            let
+              sheetCorrectors :: Set (Either (Invitation' SheetCorrector) SheetCorrector)
+              sheetCorrectors = Set.fromList . map f $ Map.toList sfCorrectors
+                where
+                  f (Left email, invData) = Left (email, sid, invData)
+                  f (Right uid, (InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector)) = Right $ SheetCorrector uid sid load cState
+              (invites, adds) = partitionEithers $ Set.toList sheetCorrectors
+
+            deleteWhere [ SheetCorrectorSheet ==. sid ]
+            insertMany_ adds
+
+            deleteWhere [InvitationFor ==. invRef @SheetCorrector sid, InvitationEmail /<-. toListOf (folded . _1) invites]
+            sinkInvitationsF correctorInvitationConfig invites
+  
             return True
-      when saveOkay $ redirect $ case msId of
+      when saveOkay $
-        Just _  -> CSheetR tid ssh csh sfName SShowR -- redirect must happen outside of runDB
+        redirect $ CSheetR tid ssh csh sfName SShowR -- redirect must happen outside of runDB
-        Nothing -> CSheetR tid ssh csh sfName SCorrR
     (FormFailure msgs) -> forM_ msgs $ (addMessage Error) . toHtml
     _ -> runDB $ warnTermDays tid $ Map.fromList [ (date,name) | (Just date, name) <-
             [(sfVisibleFrom  =<< template, MsgSheetVisibleFrom)
-            ,(sfActiveFrom   <$> template, MsgSheetActiveFrom)
+            ,(sfActiveFrom   =<< template, MsgSheetActiveFrom)
-            ,(sfActiveTo     <$> template, MsgSheetActiveTo)
+            ,(sfActiveTo     =<< template, MsgSheetActiveTo)
             ,(sfHintFrom     =<< template, MsgSheetSolutionFromTip)
             ,(sfSolutionFrom =<< template, MsgSheetSolutionFrom)
             ] ]
@@ -641,14 +686,14 @@ insertSheetFile sid ftype finfo = do
       fid <- insert file
       void . insert $ SheetFile sid fid ftype -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step
 
-insertSheetFile' :: SheetId -> SheetFileType -> ConduitT () (Either FileId File) Handler () -> YesodDB UniWorX ()
+insertSheetFile' :: SheetId -> SheetFileType -> ConduitT () (Either FileId File) Handler () -> YesodJobDB UniWorX ()
 insertSheetFile' sid ftype fs = do
     oldFileIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
       E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
       E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sid
            E.&&. sheetFile E.^. SheetFileType    E.==. E.val ftype
       return (file E.^. FileId)
-    keep <- execWriterT . runConduit $ transPipe (lift . lift) fs .| C.mapM_ finsert
+    keep <- execWriterT . runConduit $ transPipe liftHandler fs .| C.mapM_ finsert
     mapM_ deleteCascade $ (oldFileIds \\ keep :: Set FileId)
   where
     finsert (Left fileId) = tell $ singleton fileId
@@ -657,22 +702,12 @@ insertSheetFile' sid ftype fs = do
       void . insert $ SheetFile sid fid ftype -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step
 
 
-data CorrectorForm = CorrectorForm
+defaultLoads :: CourseId -> DB Loads
-  { cfUserId :: UserId
-  , cfUserName :: Text
-  , cfResult :: FormResult (CorrectorState, Load)
-  , cfViewByTut, cfViewProp, cfViewDel, cfViewState :: FieldView UniWorX
-  }
-
-type Loads = Map (Either UserEmail UserId) (CorrectorState, Load)
-
-defaultLoads :: SheetId -> DB Loads
 -- ^ Generate `Loads` in such a way that minimal editing is required
 --
 -- For every user, that ever was a corrector for this course, return their last `Load`.
 -- "Last `Load`" is taken to mean their `Load` on the `Sheet` with the most recent creation time (first edit).
-defaultLoads shid = do
+defaultLoads cId = do
-  cId <- sheetCourse <$> getJust shid
   fmap toMap . E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> E.distinctOnOrderBy [E.asc (sheetCorrector E.^. SheetCorrectorUser)] $ do
     E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
 
@@ -687,37 +722,20 @@ defaultLoads shid = do
     return (sheetCorrector E.^. SheetCorrectorUser, sheetCorrector E.^. SheetCorrectorLoad, sheetCorrector E.^. SheetCorrectorState)
   where
     toMap :: [(E.Value UserId, E.Value Load, E.Value CorrectorState)] -> Loads
-    toMap = foldMap $ \(E.Value uid, E.Value cLoad, E.Value cState) -> Map.singleton (Right uid) (cState, cLoad)
+    toMap = foldMap $ \(E.Value uid, E.Value cLoad, E.Value cState) -> Map.singleton (Right uid) (InvDBDataSheetCorrector cLoad cState, InvTokenDataSheetCorrector)
 
 
-correctorForm :: SheetId -> AForm Handler (Set (Either (Invitation' SheetCorrector) SheetCorrector))
+correctorForm :: Loads -> AForm Handler Loads
-correctorForm shid = wFormToAForm $ do
+correctorForm loads' = wFormToAForm $ do
   currentRoute <- fromMaybe (error "correctorForm called from 404-handler") <$> liftHandler getCurrentRoute
   userId <- liftHandler requireAuthId
   MsgRenderer mr <- getMsgRenderer
 
   let
-    currentLoads :: DB Loads
-    currentLoads = Map.union
-      <$> fmap (foldMap $ \(Entity _ SheetCorrector{..}) -> Map.singleton (Right sheetCorrectorUser) (sheetCorrectorState, sheetCorrectorLoad)) (selectList [ SheetCorrectorSheet ==. shid ] [])
-      <*> fmap (fmap ((,) <$> invDBSheetCorrectorState <*> invDBSheetCorrectorLoad) . Map.mapKeysMonotonic Left) (sourceInvitationsF shid)
-  (defaultLoads', currentLoads') <- liftHandler . runDB $ (,) <$> defaultLoads shid <*> currentLoads
-
-  isWrite <- liftHandler $ isWriteRequest currentRoute
-
-  let
-    applyDefaultLoads = Map.null currentLoads' && not isWrite
     loads :: Map (Either UserEmail UserId) (CorrectorState, Load)
-    loads
+    loads = loads' <&> \(InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector) -> (cState, load)
-      | applyDefaultLoads = defaultLoads'
-      | otherwise         = currentLoads'
 
-  countTutRes <- wreq checkBoxField (fslI MsgCountTutProp & setTooltip MsgCountTutPropTip) . Just . any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads
+  countTutRes <- wpopt checkBoxField (fslI MsgCountTutProp & setTooltip MsgCountTutPropTip) . Just . any (\(_, Load{..}) -> fromMaybe False byTutorial) $ Map.elems loads
-
-  -- when (not (Map.null loads) && applyDefaultLoads) $       -- Alert Message
-  --   addMessageI Warning MsgCorrectorsDefaulted
-  when (not (Map.null loads) && applyDefaultLoads) $          -- Alert Notification
-    wformMessage =<< messageIconI Warning IconNoCorrectors MsgCorrectorsDefaulted
 
 
   let
@@ -804,51 +822,16 @@ correctorForm shid = wFormToAForm $ do
     miIdent :: Text
     miIdent = "correctors"
 
-    postProcess :: Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)) -> Set (Either (Invitation' SheetCorrector) SheetCorrector)
+    postProcess :: Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)) -> Loads
-    postProcess = Set.fromList . map postProcess' . Map.elems
+    postProcess = Map.fromList . map postProcess' . Map.elems
-      where
+      where 
-        sheetCorrectorSheet = shid
+        postProcess' :: (Either UserEmail UserId, (CorrectorState, Load)) -> (Either UserEmail UserId, (InvitationDBData SheetCorrector, InvitationTokenData SheetCorrector))
-
+        postProcess' = over _2 $ \(cState, load) -> (InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector)
-        postProcess' :: (Either UserEmail UserId, (CorrectorState, Load)) -> Either (Invitation' SheetCorrector) SheetCorrector
-        postProcess' (Right sheetCorrectorUser, (sheetCorrectorState, sheetCorrectorLoad)) = Right SheetCorrector{..}
-        postProcess' (Left email, (cState, load)) = Left (email, shid, (InvDBDataSheetCorrector load cState, InvTokenDataSheetCorrector))
 
     filledData :: Maybe (Map ListPosition (Either UserEmail UserId, (CorrectorState, Load)))
     filledData = Just . Map.fromList . zip [0..] $ Map.toList loads -- TODO orderBy Name?!
 
-  fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) True filledData
+  fmap postProcess <$> massInputW MassInput{..} (fslI MsgCorrectors & setTooltip MsgMassInputTip) False filledData
-
-getSCorrR, postSCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
-postSCorrR = getSCorrR
-getSCorrR tid ssh csh shn = do
-  Entity shid Sheet{..} <- runDB $ fetchSheet tid ssh csh shn
-
-  ((res,formWidget), formEnctype) <- runFormPost . identifyForm FIDcorrectors . renderAForm FormStandard $
-    (,) <$> areq checkBoxField (fslI MsgAutoAssignCorrs) (Just sheetAutoDistribute)
-        <*> correctorForm shid
-
-  case res of
-    FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
-    FormSuccess (autoDistribute, sheetCorrectors) -> runDBJobs $ do
-      update shid [ SheetAutoDistribute =. autoDistribute ]
-
-      let (invites, adds) = partitionEithers $ Set.toList sheetCorrectors
-
-      deleteWhere [ SheetCorrectorSheet ==. shid ]
-      insertMany_ adds
-
-      deleteWhere [InvitationFor ==. invRef @SheetCorrector shid, InvitationEmail /<-. toListOf (folded . _1) invites]
-      sinkInvitationsF correctorInvitationConfig invites
-
-      addMessageI Success MsgCorrectorsUpdated
-    FormMissing -> return ()
-
-  defaultLayout $ do
-    setTitleI $ MsgSheetCorrectorsTitle tid ssh csh shn
-    wrapForm formWidget def
-      { formAction = Just . SomeRoute $ CSheetR tid ssh csh shn SCorrR
-      , formEncoding = formEnctype
-      }
 
 
 instance IsInvitableJunction SheetCorrector where
@@ -905,7 +888,7 @@ correctorInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Sheet{..}) _ = return . SomeMessage $ MsgSheetCorrInviteHeading sheetName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgSheetCorrInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ (InvDBDataSheetCorrector cLoad cState, _) _ = pure $ (JunctionSheetCorrector cLoad cState, ())
@@ -923,5 +906,5 @@ postSCorrInviteR = invitationR correctorInvitationConfig
 getSIsCorrR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 -- NOTE: The route SIsCorrR is only used to verfify corrector access rights to given sheet!
 getSIsCorrR _ _ _ shn = do
-  defaultLayout $ [whamlet|You have corrector access to #{shn}.|]
+  defaultLayout . i18n $ MsgHaveCorrectorAccess shn
 

src/Handler/Submission.hs

@@ -107,7 +107,7 @@ submissionUserInvitationConfig = InvitationConfig{..}
     invitationTokenConfig (Entity _ Submission{..}) _ = do
       Sheet{..} <- getJust submissionSheet
       Course{..} <- getJust sheetCourse
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       itAddAuth <- either throwM (return . Just) $ routeAuthTags (CSheetR courseTerm courseSchool courseShorthand sheetName SubmissionNewR)
       let itExpiresAt = Nothing
           itStartsAt = Nothing
@@ -125,7 +125,7 @@ submissionUserInvitationConfig = InvitationConfig{..}
       return . SomeRoute $ CSubmissionR courseTerm courseSchool courseShorthand sheetName cID SubShowR
 
 
-makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe (ConduitT () File Handler ()), Set (Either UserEmail UserId))
+makeSubmissionForm :: CourseId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe FileUploads, Set (Either UserEmail UserId))
 makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
   <$> fileUploadForm (not isLecturer && is _Nothing msmid) (fslI . bool MsgSubmissionFile MsgSubmissionArchive) uploadMode
   <*> wFormToAForm submittorsForm
@@ -265,6 +265,8 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
 
           postProcess :: Map ListPosition (Either UserEmail UserId, ()) -> Set (Either UserEmail UserId)
           postProcess = setOf $ folded . _1
+        when (maxSize > Just 1) $
+          wformMessage =<< messageI Info MsgCosubmittorTip
         fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers)
 
 
@@ -428,7 +430,7 @@ submissionHelper tid ssh csh shn mcid = do
             (Nothing, Just smid)   -- no new files, existing submission partners updated
               -> return smid
             (Just files, _) -> -- new files
-              runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkSubmission uid (maybe (Left shid) Right msmid) False
+              runConduit $ transPipe (lift . lift) files .| Conduit.mapM (either get404 return) .| extractRatingsMsg .| sinkSubmission uid (maybe (Left shid) Right msmid) False
             (Nothing, Nothing) -- new submission, no file upload requested
               -> do
                 sid <- insert Submission
@@ -484,7 +486,7 @@ submissionHelper tid ssh csh shn mcid = do
             | otherwise -> case change of
               Left subEmail -> deleteInvitation @SubmissionUser smid subEmail
               Right subUid  -> do
-                deleteWhere [SubmissionUserUser ==. subUid]
+                deleteBy $ UniqueSubmissionUser subUid smid
                 audit $ TransactionSubmissionUserDelete smid subUid
           
           addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated

src/Handler/SystemMessage.hs

@@ -23,6 +23,7 @@ postMessageR cID = do
         Nothing -> (systemMessageSummary, systemMessageContent)
         Just SystemMessageTranslation{..} -> (systemMessageTranslationSummary, systemMessageTranslationContent)
 
+  MsgRenderer mr <- getMsgRenderer
   let
     mkForm = do
       ((modifyRes, modifyView), modifyEnctype) <- runFormPost . identifyForm FIDSystemMessageModify . renderAForm FormStandard
@@ -31,9 +32,9 @@ postMessageR cID = do
           <*> aopt utcTimeField (fslI MsgSystemMessageTo) (Just systemMessageTo)
           <*> areq checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) (Just systemMessageAuthenticatedOnly)
           <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) (Just systemMessageSeverity)
-          <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just systemMessageDefaultLanguage)
+          <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageDefaultLanguage)
-          <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageContent)
+          <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageContent)
-          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageSummary)
+          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") (Just systemMessageSummary)
 
       ts <- runDB $ selectList [ SystemMessageTranslationMessage ==. smId ] [Asc SystemMessageTranslationLanguage]
       let ts' = Map.fromList $ (systemMessageTranslationLanguage . entityVal &&& id) <$> ts
@@ -45,9 +46,9 @@ postMessageR cID = do
           <$> fmap (Entity tId)
               ( SystemMessageTranslation
                   <$> pure systemMessageTranslationMessage
-                  <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just systemMessageTranslationLanguage)
+                  <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just systemMessageTranslationLanguage)
-                  <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageTranslationContent)
+                  <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") (Just systemMessageTranslationContent)
-                  <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageTranslationSummary)
+                  <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") (Just systemMessageTranslationSummary)
               )
           <*> combinedButtonFieldF ""
 
@@ -56,9 +57,9 @@ postMessageR cID = do
       ((addTransRes, addTransView), addTransEnctype) <- runFormPost . identifyForm FIDSystemMessageAddTranslation . renderAForm FormStandard
         $ SystemMessageTranslation
           <$> pure smId
-          <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") Nothing
+          <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) Nothing
-          <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing
+          <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing
-          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") Nothing
+          <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") Nothing
 
       formResult modifyRes $ modifySystemMessage smId
 
@@ -252,14 +253,15 @@ postMessageListR = do
     FormSuccess (_, _selection) -- prop> null _selection
       -> addMessageI Error MsgSystemMessageEmptySelection
 
+  MsgRenderer mr <- getMsgRenderer
   ((addRes, addView), addEncoding) <- runFormPost . identifyForm FIDSystemMessageAdd . renderAForm FormStandard $ SystemMessage
     <$> aopt utcTimeField (fslI MsgSystemMessageFrom) Nothing
     <*> aopt utcTimeField (fslI MsgSystemMessageTo) Nothing
     <*> areq checkBoxField (fslI MsgSystemMessageAuthenticatedOnly) Nothing
     <*> areq (selectField optionsFinite) (fslI MsgSystemMessageSeverity) Nothing
-    <*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just $ NonEmpty.head appLanguages)
+    <*> areq (langField False) (fslpI MsgSystemMessageLanguage (mr MsgRFC1766)) (Just $ NonEmpty.head appLanguages)
-    <*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") Nothing
+    <*> areq htmlField' (fslpI MsgSystemMessageContent "Html") Nothing
-    <*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") Nothing
+    <*> aopt htmlField' (fslpI MsgSystemMessageSummary "Html") Nothing
 
   case addRes of
     FormMissing -> return ()

src/Handler/Term.hs

@@ -7,6 +7,8 @@ import qualified Data.Map as Map
 import qualified Database.Esqueleto as E
 
 import qualified Data.Set as Set
+
+import qualified Control.Monad.State.Class as State
   
 
 -- | Default start day of term for season,
@@ -18,32 +20,15 @@ defaultDay True  Summer = fromGregorian 2020  4  1
 defaultDay False Summer = fromGregorian 2020  9 30
 
 
-validateTerm :: Term -> [Text]
+validateTerm :: (MonadHandler m, HandlerSite m ~ UniWorX)
-validateTerm Term{..} =
+             => FormValidator Term m ()
-  [ msg  | (False, msg) <-
+validateTerm = do
-    [ --startOk
+  Term{..} <- State.get
-      ( termStart `withinTerm` termName
+  guardValidation MsgTermStartMustMatchName $ termStart `withinTerm` termName
-      , "Jahreszahl im Namenskürzel stimmt nicht mit Semesterbeginn überein."
+  guardValidation MsgTermEndMustBeAfterStart $ termStart < termEnd
-      )
+  guardValidation MsgTermLectureEndMustBeAfterStart $ termLectureStart < termLectureEnd
-    , -- endOk
+  guardValidation MsgTermStartMustBeBeforeLectureStart $ termStart <= termLectureStart
-      ( termStart < termEnd
+  guardValidation MsgTermEndMustBeAfterLectureEnd $ termEnd >= termLectureEnd
-      , "Semester darf nicht enden, bevor es begann."
-      )
-    , -- startOk
-      ( termLectureStart < termLectureEnd
-      , "Vorlesungszeit muss vor ihrem Ende anfgangen."
-      )
-    , -- lecStartOk
-      ( termStart <= termLectureStart
-      , "Semester muss vor der Vorlesungszeit beginnen."
-      )
-    , -- lecEndOk
-      ( termEnd >= termLectureEnd
-      , "Vorlesungszeit muss vor dem Semester enden."
-      )
-  ] ]
-
-
 
 
 getTermShowR :: Handler TypedContent
@@ -66,22 +51,22 @@ getTermShowR = do
     provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData)
     provideRep $ do
       let colonnadeTerms = widgetColonnade $ mconcat
-            [ sortable (Just "term-id") "Kürzel" $ \(Entity tid _, _) -> anchorCell
+            [ sortable (Just "term-id") (i18nCell MsgTermShort) $ \(Entity tid _, _) -> anchorCell
                 (TermCourseListR tid)
                 [whamlet|#{toPathPiece tid}|]
             , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) ->
                 cell $ formatTime SelFormatDate termLectureStart >>= toWidget
-            , sortable (Just "lecture-end") "Ende Vorlesungen"   $ \(Entity _ Term{..},_) ->
+            , sortable (Just "lecture-end") (i18nCell MsgTermLectureEnd) $ \(Entity _ Term{..},_) ->
                 cell $ formatTime SelFormatDate termLectureEnd >>= toWidget
-            , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
+            , sortable Nothing (i18nCell MsgTermActive) $ \(Entity _ Term{..},_) ->
                 tickmarkCell termActive
-            , sortable Nothing "Kurse" $ \(_, E.Value numCourses) ->
+            , sortable Nothing (i18nCell MsgTermCourseCount) $ \(_, E.Value numCourses) ->
                 cell [whamlet|_{MsgNumCourses numCourses}|]
-            , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
+            , sortable (Just "start") (i18nCell MsgTermStart) $ \(Entity _ Term{..},_) ->
                 cell $ formatTime SelFormatDate termStart >>= toWidget
-            , sortable (Just "end") "Semesterende"   $ \(Entity _ Term{..},_) ->
+            , sortable (Just "end") (i18nCell MsgTermEnd) $ \(Entity _ Term{..},_) ->
                 cell $ formatTime SelFormatDate termEnd >>= toWidget
-            , sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) ->
+            , sortable Nothing (i18nCell MsgTermHolidays) $ \(Entity _ Term{..},_) ->
                 cell $ do
                   termHolidays' <- mapM (formatTime SelFormatDate) termHolidays
                   [whamlet|
@@ -248,7 +233,7 @@ termToTemplate (Just Term{..}) = TermFormTemplate
     }
 
 newTermForm :: TermFormTemplate -> Form Term
-newTermForm template html = do
+newTermForm template = validateForm validateTerm $ \html -> do
     mr <- getMessageRender
     let
       tidForm
@@ -264,7 +249,7 @@ newTermForm template html = do
         (fslI MsgTermHolidays & setTooltip MsgMassInputTip)
         True
         (tftHolidays template)
-    (result, widget) <- flip (renderAForm FormStandard) html $ Term
+    flip (renderAForm FormStandard) html $ Term
       <$> tidForm
       <*> areq dayField  (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template)
       <*> areq dayField  (fslI MsgTermEndDay   & setTooltip MsgTermEndDayTooltip)   (tftEnd   template)
@@ -272,24 +257,3 @@ newTermForm template html = do
       <*> areq dayField  (fslI MsgTermLectureStart) (tftLectureStart template)
       <*> areq dayField  (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template)
       <*> areq checkBoxField (fslI MsgTermActive) (tftActive template)
-    return $ case result of
-      FormSuccess termResult
-        | errorMsgs <- validateTerm termResult
-        , not $ null errorMsgs ->
-          (FormFailure errorMsgs,
-                [whamlet|
-                  <div class="alert alert-danger">
-                    <div class="alert__content">
-                      <h4> Fehler:
-                      <ul>
-                        $forall errmsg <- errorMsgs
-                          <li> #{errmsg}
-                  ^{widget}
-                |]
-              )
-      _ -> (result, widget)
-{-
-  where
-    set :: Text -> FieldSettings site
-    set = bfs
--}

src/Handler/Tutorial/TutorInvite.hs

@@ -64,7 +64,7 @@ tutorInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Tutorial{..}) _ = return . SomeMessage $ MsgTutorInviteHeading tutorialName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgTutorInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionTutor, ())

src/Handler/Users.hs

@@ -390,7 +390,7 @@ postAdminUserR uuid = do
           }
     userDataWidget <- runDB $ makeProfileData $ Entity uid user
     siteLayout heading $ do
-      let deleteWidget   = $(widgetFile "widgets/data-delete/data-delete")
+      let deleteWidget   = $(i18nWidgetFile "data-delete")
       $(widgetFile "adminUser")
 
 
@@ -572,7 +572,7 @@ functionInvitationConfig = InvitationConfig{..}
       MsgRenderer mr <- getMsgRenderer
       return [ihamlet|_{SomeMessage $ MsgSchoolFunctionInviteExplanation (mr $ SomeMessage invTokenUserFunctionFunction)}|]
     invitationTokenConfig _ (InvDBDataUserFunction{..}, _) = do
-      itAuthority <- liftHandler requireAuthId
+      itAuthority <- Right <$> liftHandler requireAuthId
       let itExpiresAt = Just $ Just invDBUserFunctionDeadline
           itAddAuth = Nothing
           itStartsAt = Nothing

src/Handler/Users/Add.hs

@@ -76,7 +76,7 @@ postAdminUserAddR = do
         , userWarningDays             = userDefaultWarningDays
         , userShowSex                 = userDefaultShowSex
         , userNotificationSettings    = def
-        , userMailLanguages           = def
+        , userLanguages               = Nothing
         , userCsvOptions              = def
         , userTokensIssuedAfter       = Nothing
         , userCreated                 = now

src/Handler/Utils/DateTime.hs

@@ -90,7 +90,7 @@ formatTimeW :: (HasLocalTime t) => SelDateTimeFormat -> t -> Widget
 formatTimeW s t = toWidget =<< formatTime s t
 
 formatTimeMail :: (MonadMail m, HasLocalTime t) => SelDateTimeFormat -> t -> m Text
-formatTimeMail sel t = fmap fromString $ Time.formatTime <$> (getTimeLocale' . mailLanguages <$> askMailLanguages) <*> (unDateTimeFormat <$> askMailDateTimeFormat sel) <*> pure (toLocalTime t)
+formatTimeMail sel t = fmap fromString $ Time.formatTime <$> (getTimeLocale' . view _Wrapped <$> askMailLanguages) <*> (unDateTimeFormat <$> askMailDateTimeFormat sel) <*> pure (toLocalTime t)
 
 getTimeLocale :: MonadHandler m => m TimeLocale
 getTimeLocale = getTimeLocale' <$> languages

src/Handler/Utils/Exam.hs

@@ -70,7 +70,7 @@ examBonus (Entity eId Exam{..}) = runConduit $
         [ E.when_
             ( E.not_ . E.isNothing $ examRegistration E.^. ExamRegistrationOccurrence )
           E.then_
-            (       E.just (sheet E.^. SheetActiveTo) E.<=. examOccurrence E.?. ExamOccurrenceStart
+            (       E.maybe E.true ((E.<=. examOccurrence E.?. ExamOccurrenceStart) . E.just) (sheet E.^. SheetActiveTo)
               E.&&. sheet E.^. SheetVisibleFrom E.<=. examOccurrence E.?. ExamOccurrenceStart
             )
         ]

src/Handler/Utils/Form.hs

@@ -220,8 +220,17 @@ multiAction :: forall action a.
             -> FieldSettings UniWorX
             -> Maybe action
             -> (Html -> MForm Handler (FormResult a, [FieldView UniWorX]))
-multiAction acts fs@FieldSettings{..} defAction csrf = do
+multiAction = multiAction' mpopt
-  (actionRes, actionView) <- mreq (selectField . optionsF $ Map.keysSet acts) fs defAction
+  
+multiAction' :: forall action a.
+                ( RenderMessage UniWorX action, PathPiece action, Ord action )
+             => (Field Handler action -> FieldSettings UniWorX -> Maybe action -> MForm Handler (FormResult action, FieldView UniWorX))
+             -> Map action (AForm Handler a)
+             -> FieldSettings UniWorX
+             -> Maybe action
+             -> (Html -> MForm Handler (FormResult a, [FieldView UniWorX]))
+multiAction' minp acts fs@FieldSettings{..} defAction csrf = do
+  (actionRes, actionView) <- minp (selectField . optionsF $ Map.keysSet acts) fs defAction
   results <- mapM (fmap (over _2 ($ [])) . aFormToForm) acts
 
   let actionResults = view _1 <$> results
@@ -284,21 +293,12 @@ htmlField' = htmlField
 natFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i
 natFieldI msg = convertField fromInteger toInteger $ checkBool (>= 0) msg $ intMinField 0
 
-natField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
-natField d = convertField fromInteger toInteger $ checkBool (>= 0) (T.append  d " muss eine natürliche Zahl sein.") $ intMinField 0
-
-natIntField ::(Monad m, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m Integer
-natIntField = natField
-
-posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
-posIntField d = convertField fromInteger toInteger $ checkBool (> 0) (T.append  d " muss eine positive Zahl sein.") $ intMinField 1
-
 posIntFieldI :: (Monad m, Integral i, RenderMessage (HandlerSite m) msg, RenderMessage (HandlerSite m) FormMessage) => msg -> Field m i
 posIntFieldI msg = convertField fromInteger toInteger $ checkBool (> 0) msg $ intMinField 0
 
 -- | Field to request integral number > 'm'
-minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
+minIntFieldI :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage, RenderMessage (HandlerSite m) msg) => i -> msg -> Field m i
-minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intMinField m
+minIntFieldI m msg = checkBool (> m) msg $ intMinField m
 
 pointsField :: (Monad m, HandlerSite m ~ UniWorX) => Field m Points
 pointsField = pointsFieldMinMax (Just 0) Nothing
@@ -652,13 +652,17 @@ pseudonymWordField = checkMMap doCheck id $ ciField & addDatalist (return $ mkOp
       | otherwise
       = return . Left $ MsgUnknownPseudonymWord (CI.original w)
 
-specificFileField :: UploadSpecificFile -> Field Handler (ConduitT () File Handler ())
+
+type FileUploads = ConduitT () (Either FileId File) Handler ()
+  
+
+specificFileField :: UploadSpecificFile -> Field Handler FileUploads 
 specificFileField UploadSpecificFile{..} = Field{..}
   where
     fieldEnctype = Multipart
     fieldParse _ files
       | [f] <- files
-      = return . Right . Just $ yieldM (acceptFile f) .| modifyFileTitle (const $ unpack specificFileName)
+      = return . Right . Just $ yieldM (acceptFile f) .| modifyFileTitle (const $ unpack specificFileName) .| C.map Right
       | null files   = return $ Right Nothing
       | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
     fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/specificFileField")
@@ -670,14 +674,14 @@ specificFileField UploadSpecificFile{..} = Field{..}
 
 zipFileField :: Bool -- ^ Unpack zips?
              -> Maybe (NonNull (Set Extension)) -- ^ Restrictions on file extensions
-             -> Field Handler (ConduitT () File Handler ())
+             -> Field Handler FileUploads 
 zipFileField doUnpack permittedExtensions = Field{..}
   where
     fieldEnctype = Multipart
     fieldParse _ files
       | [f@FileInfo{..}] <- files
       , maybe True (anyOf (re _nullable . folded . unpacked) ((flip isExtensionOf `on` CI.foldCase) $ unpack fileName)) permittedExtensions || doUnpack
-      = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
+      = return . Right . Just $ bool (yieldM . fmap Right . acceptFile) ((.| C.map Right) . sourceFiles) doUnpack f
       | null files   = return $ Right Nothing
       | otherwise    = return . Left $ SomeMessage MsgOnlyUploadOneFile
     fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/zipFileField")
@@ -689,7 +693,7 @@ zipFileField doUnpack permittedExtensions = Field{..}
 
 fileUploadForm :: Bool -- ^ Required?
                -> (Bool -> FieldSettings UniWorX) -- ^ given @unpackZips@ generate `FieldSettings` in the case of `UploadAny`
-               -> UploadMode -> AForm Handler (Maybe (ConduitT () File Handler ()))
+               -> UploadMode -> AForm Handler (Maybe FileUploads)
 fileUploadForm isReq mkFs = \case
   NoUpload
     -> pure Nothing
@@ -698,21 +702,21 @@ fileUploadForm isReq mkFs = \case
   UploadSpecific{..}
     -> mergeFileSources <$> sequenceA (map specificFileForm . Set.toList $ toNullable specificFiles)
   where
-    specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe (ConduitT () File Handler ()))
+    specificFileForm :: UploadSpecificFile -> AForm Handler (Maybe FileUploads)
     specificFileForm spec@UploadSpecificFile{..}
       = bool (\f fs d -> aopt f fs $ fmap Just d) (\f fs d -> Just <$> areq f fs d) specificFileRequired (specificFileField spec) (fsl specificFileLabel) Nothing
 
-    mergeFileSources :: [Maybe (ConduitT () File Handler ())] -> Maybe (ConduitT () File Handler ())
+    mergeFileSources :: [Maybe FileUploads] -> Maybe FileUploads 
     mergeFileSources (catMaybes -> sources) = case sources of
       [] -> Nothing
       fs -> Just $ sequence_ fs
 
-multiFileField' :: ConduitT () (Either FileId File) Handler () -- ^ Permitted files in same format as produced by `multiFileField`
+multiFileField' :: FileUploads -- ^ Permitted files in same format as produced by `multiFileField`
-                -> Field Handler (ConduitT () (Either FileId File) Handler ())
+                -> Field Handler FileUploads 
 multiFileField' permittedFiles = multiFileField . runConduit $ permittedFiles .| C.mapMaybe (preview _Left) .| C.foldMap Set.singleton
 
 multiFileField :: Handler (Set FileId) -- ^ Set of files that may be submitted by id-reference
-               -> Field Handler (ConduitT () (Either FileId File) Handler ())
+               -> Field Handler FileUploads 
 multiFileField permittedFiles' = Field{..}
   where
     fieldEnctype = Multipart
@@ -755,7 +759,7 @@ multiFileField permittedFiles' = Field{..}
       $(widgetFile "widgets/multiFileField")
     unpackZips :: Text
     unpackZips = "unpack-zip"
-    takeLefts :: Monad m => ConduitM (Either b a) b m ()
+    takeLefts :: Monad m => ConduitT (Either b a) b m ()
     takeLefts = awaitForever $ \case
       Right _ -> return ()
       Left  r -> yield r
@@ -831,7 +835,7 @@ sheetGroupAFormReq fs template = multiActionA selOptions fs (classify' <$> templ
   where
     selOptions = Map.fromList
       [ ( Arbitrary', Arbitrary
-          <$> apreq (natField "Gruppengröße") (fslI MsgSheetGroupMaxGroupsize & noValidate) (preview _maxParticipants =<< template)
+          <$> apreq (natFieldI MsgGroupSizeNotNatural) (fslI MsgSheetGroupMaxGroupsize & noValidate) (preview _maxParticipants =<< template)
         )
       , ( RegisteredGroups', pure RegisteredGroups )
       , ( NoGroups', pure NoGroups )
@@ -861,6 +865,10 @@ dayTimeField fs mutc = do
       | otherwise = (Nothing,Nothing)
 -}
 
+fieldTimeFormat :: String
+-- fieldTimeFormat = "%e.%m.%y %k:%M"
+fieldTimeFormat = "%Y-%m-%dT%H:%M:%S"
+  
 localTimeField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m LocalTime
 localTimeField = Field
     { fieldParse = parseHelperGen readTime
@@ -873,11 +881,7 @@ localTimeField = Field
     , fieldEnctype = UrlEncoded
     }
   where
-    fieldTimeFormat :: String
+    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any words
-    --fieldTimeFormat = "%e.%m.%y %k:%M"
-    fieldTimeFormat = "%Y-%m-%dT%H:%M:%S"
-
-    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any
     readTime :: Text -> Either UniWorXMessage LocalTime
     readTime t =
       case parseTimeM True defaultTimeLocale fieldTimeFormat (T.unpack t) of
@@ -925,8 +929,8 @@ jsonField hide = Field{..}
 boolField :: ( MonadHandler m
              , HandlerSite m ~ UniWorX
              )
-          => Field m Bool
+          => Maybe (SomeMessage UniWorX) -> Field m Bool
-boolField = Field
+boolField mkNone = Field
   { fieldParse = \e _ -> return $ boolParser e
   , fieldView = \theId name attrs val isReq -> $(widgetFile "widgets/fields/bool")
   , fieldEnctype = UrlEncoded
@@ -1150,7 +1154,7 @@ multiUserField onlySuggested suggestions = Field{..}
             case dbRes of
               [] -> return $ Left email
               [E.Value uid] -> return $ Right uid
-              _other -> throwE $ SomeMessage ("Ambiguous e-mail addr" :: Text)
+              _other -> throwE $ SomeMessage MsgAmbiguousEmail
 
 examResultField :: forall m res.
                    ( MonadHandler m
@@ -1244,13 +1248,14 @@ csvFormatOptionsForm fs mPrev = hoistAForm liftHandler . multiActionA csvActs fs
       MsgRenderer mr <- getMsgRenderer
       let
         opts = 
-          [ (MsgCsvDelimiterNull,    '\0')
+          [ (MsgCsvDelimiterNull,      '\0')
-          , (MsgCsvDelimiterTab,     '\t')
+          , (MsgCsvDelimiterTab,       '\t')
-          , (MsgCsvDelimiterComma,   ',')
+          , (MsgCsvDelimiterComma,     ',')
-          , (MsgCsvDelimiterColon,   chr 58)
+          , (MsgCsvDelimiterColon,     chr 58)
-          , (MsgCsvDelimiterBar,     '|')
+          , (MsgCsvDelimiterSemicolon, chr 59)
-          , (MsgCsvDelimiterSpace,   ' ')
+          , (MsgCsvDelimiterBar,       '|')
-          , (MsgCsvDelimiterUnitSep, chr 31)
+          , (MsgCsvDelimiterSpace,     ' ')
+          , (MsgCsvDelimiterUnitSep,   chr 31)
           ]
         olReadExternal t = do
           i <- readMay t

src/Handler/Utils/I18n.hs

@@ -1,14 +1,22 @@
 module Handler.Utils.I18n
-  where
+  ( i18nWidgetFile
+  , i18nWidgetFilesAvailable, i18nWidgetFilesAvailable', i18nWidgetFiles
+  ) where
 
 import Import
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (qRunIO)
+import qualified Language.Haskell.TH.Syntax as TH
 
 import qualified Data.List as List
 import qualified Data.List.NonEmpty as NonEmpty
 
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+
+import qualified Data.Text as Text
+
 import System.Directory (listDirectory)
 import System.FilePath.Posix (takeBaseName)
 
@@ -40,4 +48,31 @@ i18nWidgetFile basename = do
     [ funD ws $ [ clause [litP $ stringL l] (normalB . widgetFile $ "i18n" </> basename </> l) []
                 | l <- unpack <$> NonEmpty.toList availableTranslations' -- One function definition for every available language
                 ] ++ [ clause [wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match
-    ] [e|selectLanguage availableTranslations' >>= $(varE ws)|]
+    ] [e|selectLanguage availableTranslations' >>= $(varE ws)|]
+
+i18nWidgetFilesAvailable' :: FilePath -> Q (Map Text (NonEmpty Text))
+i18nWidgetFilesAvailable' basename = do
+  let i18nDirectory = "templates" </> "i18n" </> basename
+  availableFiles <- qRunIO $ listDirectory i18nDirectory
+  let fileKinds' = fmap (pack . dropExtension . takeBaseName &&& toTranslation . pack . takeBaseName) availableFiles
+      fileKinds :: Map Text [Text]
+      fileKinds = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . Set.toList <$> Map.fromListWith Set.union [ (kind, Set.singleton l) | (kind, Just l) <- fileKinds' ]
+      toTranslation fName = listToMaybe . sortOn length . mapMaybe (flip Text.stripPrefix fName . (<>".")) $ map fst fileKinds'
+
+  iforM fileKinds $ \kind -> maybe (fail $ "‘" <> i18nDirectory <> "’ has no translations for ‘" <> unpack kind <> "’") return . NonEmpty.nonEmpty
+
+i18nWidgetFilesAvailable :: FilePath -> Q Exp
+i18nWidgetFilesAvailable = TH.lift <=< i18nWidgetFilesAvailable'
+  
+i18nWidgetFiles :: FilePath -> Q Exp
+i18nWidgetFiles basename = do
+  availableTranslations' <- i18nWidgetFilesAvailable' basename
+
+  -- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time
+  ws <- newName "ws" -- Name for dispatch function
+  letE
+    [ funD ws $ [ clause [litP $ stringL kind, litP $ stringL l] (normalB [e|$(widgetFile $ "i18n" </> basename </> kind <.> l) :: Widget|]) []
+                | (unpack -> kind, ls) <- Map.toList availableTranslations'
+                , l <- unpack <$> NonEmpty.toList ls
+                ] ++ [ clause [wildP, wildP] (normalB [e| error "selectLanguage returned an invalid translation" |]) [] ] -- Fallback mostly there so compiler does not complain about non-exhaustive pattern match
+    ] [e|imap (\kind ls -> selectLanguage ls >>= $(varE ws) kind) availableTranslations'|]

src/Handler/Utils/Invitations.hs

@@ -144,7 +144,7 @@ data InvitationConfig junction = forall formCtx. InvitationConfig
 
 -- | Additional configuration needed for an invocation of `bearerToken`
 data InvitationTokenConfig = InvitationTokenConfig
-  { itAuthority :: UserId
+  { itAuthority :: Either Value UserId
   , itAddAuth   :: Maybe AuthDNF
   , itExpiresAt :: Maybe (Maybe UTCTime)
   , itStartsAt  :: Maybe UTCTime

src/Handler/Utils/Mail.hs

@@ -47,14 +47,14 @@ userMailT :: ( MonadHandler m
              ) => UserId -> MailT m a -> m a
 userMailT uid mAct = do
   user@User
-    { userMailLanguages
+    { userLanguages
     , userDateTimeFormat
     , userDateFormat
     , userTimeFormat
     } <- liftHandler . runDB $ getJust uid
   let
     ctx = MailContext
-      { mcLanguages = userMailLanguages
+      { mcLanguages = fromMaybe def userLanguages
       , mcDateTimeFormat = \case
           SelFormatDateTime -> userDateTimeFormat
           SelFormatDate -> userDateFormat

src/Handler/Utils/Rating.hs

@@ -47,8 +47,8 @@ instance Pretty x => Pretty (CI x) where
 
 
 instance Pretty SheetGrading where
-  pretty Points{..}     = pretty ( show maxPoints <> " Punkte" :: String)
+  pretty Points{..}     = pretty ( "Maximal " <> show maxPoints <> " Punkt(e)" :: String)
-  pretty PassPoints{..} = pretty ( show maxPoints <> " Punkte, bestanden ab " <> show passingPoints <> " Punkte" :: String )
+  pretty PassPoints{..} = pretty ( "Maximal " <> show maxPoints <> " Punkt(e), bestanden ab " <> show passingPoints <> " Punkt(en)" :: String )
   pretty PassBinary     = pretty ( "Bestanden (1) /  Nicht bestanden (0)" :: String )
 
 
@@ -113,7 +113,7 @@ formatRating cID Rating{ ratingValues = Rating'{..}, ..} = let
       [ Just $ "Veranstaltung:" <+> pretty ratingCourseName
       , Just $ "Blatt:" <+> pretty ratingSheetName
       , ("Korrektor:" <+>) . pretty <$> ratingCorrectorName
-      , ("Bewertung:" <+>) . pretty <$> (ratingSheetType ^? _grading)
+      , ("Bewertungsschema:" <+>) . pretty <$> (ratingSheetType ^? _grading)
       ]
     , "Abgabe-Id:" <+> pretty (Text.unpack $ toPathPiece cID)
     , "============================================="

src/Handler/Utils/Routes.hs

@@ -0,0 +1,11 @@
+module Handler.Utils.Routes
+  ( classifyHandler
+  ) where
+
+import Import
+
+import Utils.TH.Routes
+
+
+classifyHandler :: Route UniWorX -> String
+classifyHandler = $(classifyHandler' uniworxRoutes)

src/Handler/Utils/Sheet.hs

@@ -10,7 +10,7 @@ import qualified Database.Esqueleto.Internal.Sql as E
 -- | Map sheet file types to their visibily dates of a given sheet, for convenience
 sheetFileTypeDates :: Sheet -> SheetFileType -> Maybe UTCTime
 sheetFileTypeDates Sheet{..} = \case
-  SheetExercise -> Just sheetActiveFrom
+  SheetExercise -> sheetActiveFrom
   SheetHint     -> sheetHintFrom
   SheetSolution -> sheetSolutionFrom
   SheetMarking  -> Nothing

src/Handler/Utils/Submission.hs

@@ -50,6 +50,8 @@ import Text.Hamlet (ihamletFile)
 
 import qualified Control.Monad.Catch as E (Handler(..))
 
+import qualified Data.CaseInsensitive as CI
+
 data AssignSubmissionException = NoCorrectors
                                | NoCorrectorsByProportion
                                | SubmissionsNotFound (NonNull (Set SubmissionId))
@@ -428,7 +430,7 @@ sinkSubmission userId mExists isUpdate = do
       , Just (map unpack . Set.toList . toNullable -> exts) <- extensionRestriction
       = Conduit.mapM $ \x -> if
           | Left File{..} <- x
-          , none (`isExtensionOf` fileTitle) exts
+          , none ((flip isExtensionOf `on` CI.foldCase) fileTitle) exts
           , isn't _Nothing fileContent -- File record is not a directory, we don't care about those
             -> throwM $ InvalidFileTitleExtension fileTitle
           | otherwise

src/Handler/Utils/Table/Columns.hs

@@ -203,7 +203,7 @@ fltrAllocationActive cTime queryAllocation = singletonMap "active" . FilterColum
         E.&&. E.maybe E.true  (\t -> E.val cTime E.<=. t) (allocation E.^. AllocationRegisterTo)
 
 fltrAllocationActiveUI :: DBFilterUI
-fltrAllocationActiveUI mPrev = prismAForm (singletonFilter "active" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgAllocationActive)
+fltrAllocationActiveUI mPrev = prismAForm (singletonFilter "active" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAllocationActive)
 
 
 -----------
@@ -355,7 +355,7 @@ fltrApplicationVeto :: OpticFilterColumn t Bool
 fltrApplicationVeto queryVeto = singletonMap "veto" . FilterColumn . mkExactFilter $ view queryVeto
 
 fltrApplicationVetoUI :: DBFilterUI
-fltrApplicationVetoUI mPrev = prismAForm (singletonFilter "veto" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgCourseApplicationVeto)
+fltrApplicationVetoUI mPrev = prismAForm (singletonFilter "veto" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgCourseApplicationVeto)
 
 colApplicationRatingComment :: OpticColonnade (Maybe Text)
 colApplicationRatingComment resultComment = Colonnade.singleton (fromSortable header) body
@@ -407,7 +407,7 @@ fltrApplicationFiles :: OpticFilterColumn t Bool
 fltrApplicationFiles queryFiles = singletonMap "has-files" . FilterColumn . mkExactFilter $ view queryFiles
 
 fltrApplicationFilesUI :: DBFilterUI
-fltrApplicationFilesUI mPrev = prismAForm (singletonFilter "has-files" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgCourseApplicationFiles)
+fltrApplicationFilesUI mPrev = prismAForm (singletonFilter "has-files" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgCourseApplicationFiles)
 
 ---------------
 -- Files

src/Import/NoModel.hs

@@ -142,6 +142,7 @@ import Text.Blaze.Instances as Import ()
 import Jose.Jwt.Instances as Import ()
 import Web.PathPieces.Instances as Import ()
 import Data.Universe.Instances.Reverse.MonoTraversable ()
+import Data.Universe.Instances.Reverse.WithIndex ()
 import Database.Persist.Class.Instances as Import ()
 import Database.Persist.Types.Instances as Import ()
 import Data.UUID.Instances as Import ()
@@ -152,6 +153,9 @@ import Crypto.Hash.Instances as Import ()
 import Colonnade.Instances as Import ()
 import Data.Bool.Instances as Import ()
 import Data.Encoding.Instances as Import ()
+import Prometheus.Instances as Import ()
+
+import Crypto.Hash as Import (Digest, SHA3_256)
 
 import Control.Lens as Import
   hiding ( (<.>)

src/Jobs.hs

@@ -71,6 +71,7 @@ import Jobs.Handler.TransactionLog
 import Jobs.Handler.SynchroniseLdap
 import Jobs.Handler.PruneInvitations
 import Jobs.Handler.ChangeUserDisplayEmail
+import Jobs.Handler.PruneFiles
 
 import Jobs.HealthReport
 
@@ -250,23 +251,26 @@ execCrontab :: RWST JobContext () (HashMap JobCtl (Max UTCTime)) (HandlerFor Uni
 -- ^ Keeping a `HashMap` of the latest execution times of `JobCtl`s we have
 --   seen, wait for the time of the next job and fire it
 execCrontab = do
-  mapRWST (liftHandler . runDB . setSerializable) $ do
+  let
-    let
+    mergeState :: MonadResource m => RWST _ () _ (ReaderT SqlBackend m) ()
-      mergeLastExec (Entity _leId CronLastExec{..})
+    mergeState = do
-        | Just job <- Aeson.parseMaybe parseJSON cronLastExecJob
+      let
-        = State.modify $ HashMap.insertWith (<>) (JobCtlQueue job) (Max cronLastExecTime)
+        mergeLastExec (Entity _leId CronLastExec{..})
-        | otherwise = return ()
+          | Just job <- Aeson.parseMaybe parseJSON cronLastExecJob
+          = State.modify $ HashMap.insertWith (<>) (JobCtlQueue job) (Max cronLastExecTime)
+          | otherwise = return ()
 
-      mergeQueued (Entity _qjId QueuedJob{..})
+        mergeQueued (Entity _qjId QueuedJob{..})
-        | Just job <- Aeson.parseMaybe parseJSON queuedJobContent
+          | Just job <- Aeson.parseMaybe parseJSON queuedJobContent
-        = State.modify $ HashMap.insertWith (<>) (JobCtlQueue job) (Max queuedJobCreationTime)
+          = State.modify $ HashMap.insertWith (<>) (JobCtlQueue job) (Max queuedJobCreationTime)
-        | otherwise = return ()
+          | otherwise = return ()
-    runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ mergeLastExec
+      runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ mergeLastExec
-    runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ mergeQueued
+      runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ mergeQueued
+  mapRWST (liftHandler . runDB . setSerializable) $ mergeState
 
   refT <- liftIO getCurrentTime
   settings <- getsYesod appSettings'
-  (currentCrontab, (jobCtl, nextMatch)) <- mapRWST (liftIO . atomically) $ do
+  (currentCrontab, (jobCtl, nextMatch), currentState) <- mapRWST (liftIO . atomically) $ do
     crontab <- liftBase . readTVar =<< asks jobCrontab
 
     State.modify . HashMap.filterWithKey $ \k _ -> HashMap.member k crontab
@@ -274,7 +278,7 @@ execCrontab = do
     case earliestJob settings prevExec crontab refT of
       Nothing -> liftBase retry
       Just (_, MatchNone) -> liftBase retry
-      Just x -> return (crontab, x)
+      Just x -> return (crontab, x, prevExec)
 
   do
     lastTimes <- State.get
@@ -283,18 +287,24 @@ execCrontab = do
 
   let doJob = mapRWST (liftHandler . runDBJobs . setSerializable) $ do
           newCrontab <- lift . hoist lift $ determineCrontab'
-          if
+          when (newCrontab /= currentCrontab) $ 
-            | ((==) `on` HashMap.lookup jobCtl) newCrontab currentCrontab
+            mapRWST (liftIO . atomically) $
-              -> do
+              liftBase . void . flip swapTVar newCrontab =<< asks jobCrontab
-                now <- liftIO $ getCurrentTime
+
-                foundation <- getYesod
+          mergeState
-                State.modify $ HashMap.alter (Just . ($ Max now) . maybe id (<>)) jobCtl
+          newState <- State.get
-                case jobCtl of
+
-                  JobCtlQueue job -> lift $ queueDBJobCron job
+          let upToDate = and
-                  other -> runReaderT ?? foundation $ writeJobCtl other
+                [ ((==) `on` HashMap.lookup jobCtl) newCrontab currentCrontab
-            | otherwise
+                , ((==) `on` HashMap.lookup jobCtl) newState   currentState
-              -> mapRWST (liftIO . atomically) $
+                ]
-                   liftBase . void . flip swapTVar newCrontab =<< asks jobCrontab
+          when upToDate $ do
+            now <- liftIO $ getCurrentTime
+            foundation <- getYesod
+            State.modify $ HashMap.alter (Just . ($ Max now) . maybe id (<>)) jobCtl
+            case jobCtl of
+              JobCtlQueue job -> lift $ queueDBJobCron job
+              other -> runReaderT ?? foundation $ writeJobCtl other
 
   case nextMatch of
     MatchAsap -> doJob

src/Jobs/Crontab.hs

@@ -49,6 +49,15 @@ determineCrontab = execWriterT $ do
       , cronRateLimit = appJobCronInterval
       , cronNotAfter = Right CronNotScheduled
       }
+  whenIsJust appPruneUnreferencedFiles $ \pInterval -> 
+    tell $ HashMap.singleton
+      (JobCtlQueue JobPruneUnreferencedFiles)
+      Cron
+        { cronInitial   = CronAsap
+        , cronRepeat    = CronRepeatScheduled CronAsap
+        , cronRateLimit = pInterval
+        , cronNotAfter  = Right CronNotScheduled
+        }
   
   oldestInvitationMUTC <- lift $ preview (_head . _entityVal . _invitationExpiresAt . _Just) <$> selectList [InvitationExpiresAt !=. Nothing] [Asc InvitationExpiresAt, LimitTo 1]
   whenIsJust oldestInvitationMUTC $ \oldestInvUTC -> tell $ HashMap.singleton
@@ -60,6 +69,16 @@ determineCrontab = execWriterT $ do
       , cronNotAfter  = Right CronNotScheduled
       }
 
+  oldestSessionFile <- lift $ preview (_head . _entityVal . _sessionFileTouched) <$> selectList [] [Asc SessionFileTouched, LimitTo 1]
+  whenIsJust oldestSessionFile $ \oldest -> tell $ HashMap.singleton
+    (JobCtlQueue JobPruneSessionFiles)
+    Cron
+      { cronInitial   = CronTimestamp . utcToLocalTime $ addUTCTime appSessionFilesExpire oldest
+      , cronRepeat    = CronRepeatOnChange
+      , cronRateLimit = appSessionFilesExpire / 2
+      , cronNotAfter  = Right CronNotScheduled
+      }
+
   tell . flip foldMap universeF $ \kind -> 
     case appHealthCheckInterval kind of
       Just int -> HashMap.singleton
@@ -144,39 +163,41 @@ determineCrontab = execWriterT $ do
 
   let
     sheetJobs (Entity nSheet Sheet{..}) = do
-      tell $ HashMap.singleton
+      for_ sheetActiveFrom $ \aFrom -> 
-        (JobCtlQueue $ JobQueueNotification NotificationSheetActive{..})
-        Cron
-          { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveFrom
-          , cronRepeat = CronRepeatNever
-          , cronRateLimit = appNotificationRateLimit
-          , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
-          }
-      tell $ HashMap.singleton
-        (JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..})
-        Cron
-          { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . max sheetActiveFrom $ addUTCTime (-nominalDay) sheetActiveTo
-          , cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour
-          , cronRateLimit = appNotificationRateLimit
-          , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
-          }
-      tell $ HashMap.singleton
-        (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
-        Cron
-          { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
-          , cronRepeat    = CronRepeatOnChange
-          , cronRateLimit = appNotificationRateLimit
-          , cronNotAfter  = Left appNotificationExpiration
-          }             
-      when sheetAutoDistribute $
         tell $ HashMap.singleton
-          (JobCtlQueue $ JobDistributeCorrections nSheet)
+          (JobCtlQueue $ JobQueueNotification NotificationSheetActive{..})
           Cron
-            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ sheetActiveTo
+            { cronInitial = CronTimestamp $ utcToLocalTimeTZ appTZ aFrom
-            , cronRepeat    = CronRepeatNever
+            , cronRepeat = CronRepeatNever
-            , cronRateLimit = 3600 -- Irrelevant due to `cronRepeat`
+            , cronRateLimit = appNotificationRateLimit
-            , cronNotAfter  = Left nominalDay
+            , cronNotAfter = Right $ maybe CronNotScheduled (CronTimestamp . utcToLocalTimeTZ appTZ) sheetActiveTo
             }
+      for_ sheetActiveTo $ \aTo -> do
+        tell $ HashMap.singleton
+          (JobCtlQueue $ JobQueueNotification NotificationSheetSoonInactive{..})
+          Cron
+            { cronInitial = CronTimestamp . utcToLocalTimeTZ appTZ . maybe id max sheetActiveFrom $ addUTCTime (-nominalDay) aTo
+            , cronRepeat = CronRepeatOnChange -- Allow repetition of the notification (if something changes), but wait at least an hour
+            , cronRateLimit = appNotificationRateLimit
+            , cronNotAfter = Right . CronTimestamp $ utcToLocalTimeTZ appTZ aTo
+            }
+        tell $ HashMap.singleton
+          (JobCtlQueue $ JobQueueNotification NotificationSheetInactive{..})
+          Cron
+            { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ aTo
+            , cronRepeat    = CronRepeatOnChange
+            , cronRateLimit = appNotificationRateLimit
+            , cronNotAfter  = Left appNotificationExpiration
+            }             
+        when sheetAutoDistribute $
+          tell $ HashMap.singleton
+            (JobCtlQueue $ JobDistributeCorrections nSheet)
+            Cron
+              { cronInitial   = CronTimestamp $ utcToLocalTimeTZ appTZ aTo
+              , cronRepeat    = CronRepeatNever
+              , cronRateLimit = 3600 -- Irrelevant due to `cronRepeat`
+              , cronNotAfter  = Left nominalDay
+              }
 
   runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ sheetJobs
 

src/Jobs/Handler/ChangeUserDisplayEmail.hs

@@ -12,7 +12,7 @@ import Text.Hamlet
 
 dispatchJobChangeUserDisplayEmail :: UserId -> UserEmail -> Handler ()
 dispatchJobChangeUserDisplayEmail jUser jDisplayEmail = do
-  token <- tokenRestrict SetDisplayEmailR jDisplayEmail <$> bearerToken jUser (Just $ HashSet.singleton SetDisplayEmailR) Nothing Nothing Nothing
+  token <- tokenRestrict SetDisplayEmailR jDisplayEmail <$> bearerToken (Right jUser) (Just $ HashSet.singleton SetDisplayEmailR) Nothing Nothing Nothing
   jwt <- encodeToken token
   let
     setDisplayEmailUrl :: SomeRoute UniWorX

src/Jobs/Handler/PruneFiles.hs

@@ -0,0 +1,38 @@
+module Jobs.Handler.PruneFiles
+  ( dispatchJobPruneSessionFiles
+  , dispatchJobPruneUnreferencedFiles
+  ) where
+
+import Import hiding (matching)
+
+import Database.Persist.Sql (deleteWhereCount)
+
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+
+
+dispatchJobPruneSessionFiles :: Handler ()
+dispatchJobPruneSessionFiles = do
+  now <- liftIO getCurrentTime
+  expires <- getsYesod $ view _appSessionFilesExpire
+  n <- runDB $ deleteWhereCount [ SessionFileTouched <. addUTCTime (- expires) now ]
+  $logInfoS "PruneSessionFiles" [st|Deleted #{n} expired session files|]
+
+
+dispatchJobPruneUnreferencedFiles :: Handler ()
+dispatchJobPruneUnreferencedFiles = do
+  n <- runDB . E.deleteCount . E.from $ \file ->
+    E.where_ . E.not_ . E.any E.exists $ references file
+  $logInfoS "PruneUnreferencedFiles" [st|Deleted #{n} unreferenced files|]
+  where
+    references :: E.SqlExpr (Entity File) -> [E.SqlQuery ()]
+    references ((E.^. FileId) -> fId) =
+      [ E.from $ \matching  -> E.where_ $ matching  E.^. AllocationMatchingLog        E.==. fId
+      , E.from $ \appInstr  -> E.where_ $ appInstr  E.^. CourseAppInstructionFileFile E.==. fId
+      , E.from $ \appFile   -> E.where_ $ appFile   E.^. CourseApplicationFileFile    E.==. fId
+      , E.from $ \matFile   -> E.where_ $ matFile   E.^. MaterialFileFile             E.==. fId
+      , E.from $ \newsFile  -> E.where_ $ newsFile  E.^. CourseNewsFileFile           E.==. fId
+      , E.from $ \sessFile  -> E.where_ $ sessFile  E.^. SessionFileFile              E.==. fId
+      , E.from $ \sheetFile -> E.where_ $ sheetFile E.^. SheetFileFile                E.==. fId
+      , E.from $ \subFile   -> E.where_ $ subFile   E.^. SubmissionFileFile           E.==. fId
+      ]

src/Jobs/Handler/SendNotification.hs

@@ -22,4 +22,10 @@ import Jobs.Handler.SendNotification.CourseRegistered
 
 
 dispatchJobSendNotification :: UserId -> Notification -> Handler ()
-dispatchJobSendNotification jRecipient jNotification = $(dispatchTH ''Notification) jNotification jRecipient
+dispatchJobSendNotification jRecipient jNotification = do
+  $(dispatchTH ''Notification) jNotification jRecipient
+
+  instanceID' <- getsYesod $ view instanceID
+  now <- liftIO getCurrentTime
+
+  runDB . insert_ $ SentNotification (toJSON jNotification) jRecipient now instanceID'

src/Jobs/Handler/SendNotification/Utils.hs

@@ -16,7 +16,7 @@ ihamletSomeMessage f trans = f $ trans . SomeMessage
 mkEditNotifications :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (HtmlUrlI18n UniWorXMessage (Route UniWorX))
 mkEditNotifications uid = liftHandler $ do
   cID <- encrypt uid
-  jwt <- encodeToken =<< bearerToken uid (Just . HashSet.singleton $ UserNotificationR cID) Nothing Nothing Nothing
+  jwt <- encodeToken =<< bearerToken (Right uid) (Just . HashSet.singleton $ UserNotificationR cID) Nothing Nothing Nothing
   let
     editNotificationsUrl :: SomeRoute UniWorX
     editNotificationsUrl = SomeRoute (UserNotificationR cID, [(toPathPiece GetBearer, toPathPiece jwt)])

src/Jobs/Handler/SendPasswordReset.hs

@@ -29,7 +29,7 @@ dispatchJobSendPasswordReset jRecipient = userMailT jRecipient $ do
       LTUUnique utc' _ -> utc'
       _other           -> UTCTime (addDays 2 $ utctDay now) 0
 
-  resetToken' <- bearerToken jRecipient (Just . HashSet.singleton $ UserPasswordR cID) Nothing (Just $ Just tomorrowEndOfDay) Nothing
+  resetToken' <- bearerToken (Right jRecipient) (Just . HashSet.singleton $ UserPasswordR cID) Nothing (Just $ Just tomorrowEndOfDay) Nothing
   let resetToken = resetToken'
         & tokenRestrict (UserPasswordR cID) (decodeUtf8 . Base64.encode . BA.convert $ computeUserAuthenticationDigest userAuthentication)
   encodedToken <- encodeToken resetToken

src/Jobs/Types.hs

@@ -67,6 +67,8 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
          | JobChangeUserDisplayEmail { jUser :: UserId
                                      , jDisplayEmail :: UserEmail
                                      }
+         | JobPruneSessionFiles
+         | JobPruneUnreferencedFiles
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                   | NotificationSheetActive { nSheet :: SheetId }

src/Mail.hs

@@ -10,7 +10,7 @@ module Mail
   , MailT, defMailT
   , MailSmtpData(..)
   , _MailSmtpDataSet
-  , MailContext(..), MailLanguages(..)
+  , MailContext(..)
   , MonadMail(..)
   , getMailMessageRender, getMailMsgRenderer
     -- * YesodMail
@@ -38,7 +38,7 @@ module Mail
 
 import ClassyPrelude.Yesod hiding (snoc, (.=), getMessageRender, derivePersistFieldJSON)
 
-import Model.Types.TH.JSON
+import Model.Types.Languages
 
 import Network.Mail.Mime hiding (addPart, addAttachment)
 import qualified Network.Mail.Mime as Mime (addPart)
@@ -89,7 +89,7 @@ import qualified Data.Binary as Binary
 import "network-bsd" Network.BSD (getHostName)
 
 import Data.Time.Zones (TZ, utcTZ, utcToLocalTimeTZ, timeZoneForUTCTime)
-import Data.Time.LocalTime (ZonedTime(..))
+import Data.Time.LocalTime (ZonedTime(..), TimeZone(..))
 import Data.Time.Format (rfc822DateFormat)
 
 import Network.HaskellNet.SMTP (SMTPConnection)
@@ -109,8 +109,6 @@ import Data.Universe.Instances.Reverse ()
 import Data.Universe.Instances.Reverse.JSON ()
 import Data.Universe.Instances.Reverse.Hashable ()
 
-import GHC.Exts (IsList)
-
 import Control.Monad.Trans.Maybe (MaybeT(..))
 
 import Data.CaseInsensitive (CI)
@@ -160,19 +158,8 @@ _MailSmtpDataSet = to $ \MailSmtpData{..} -> none id
   ]
 
 
-newtype MailLanguages = MailLanguages { mailLanguages :: [Lang] }
-  deriving (Eq, Ord, Show, Read, Generic, Typeable)
-  deriving newtype (FromJSON, ToJSON, IsList)
-
-instance Default MailLanguages where
-  def = MailLanguages []
-
-instance Hashable MailLanguages
-instance NFData MailLanguages
-
-
 data MailContext = MailContext
-  { mcLanguages :: MailLanguages
+  { mcLanguages :: Languages
   , mcDateTimeFormat :: SelDateTimeFormat -> DateTimeFormat
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
@@ -191,7 +178,7 @@ instance Default MailContext where
 makeLenses_ ''MailContext
 
 class (MonadHandler m, MonadState Mail m) => MonadMail m where
-  askMailLanguages :: m MailLanguages
+  askMailLanguages :: m Languages
   askMailDateTimeFormat :: SelDateTimeFormat -> m DateTimeFormat
   tellMailSmtpData :: MailSmtpData -> m ()
 
@@ -214,7 +201,7 @@ getMailMessageRender :: ( MonadMail m
                         , HandlerSite m ~ site
                         , RenderMessage site msg
                         ) => m (msg -> Text)
-getMailMessageRender = renderMessage <$> getYesod <*> (mailLanguages <$> askMailLanguages)
+getMailMessageRender = renderMessage <$> getYesod <*> (view _Wrapped <$> askMailLanguages)
 
 getMailMsgRenderer :: forall site m.
                       ( MonadMail m
@@ -515,8 +502,24 @@ setDateCurrent = setDate =<< liftIO getCurrentTime
 setDate :: (MonadHandler m, YesodMail (HandlerSite m)) => UTCTime -> MailT m ()
 setDate time = do
   tz <- mailDateTZ
-  let timeStr = formatTime defaultTimeLocale rfc822DateFormat $ ZonedTime (utcToLocalTimeTZ tz time) (timeZoneForUTCTime tz time)
+  let timeStr = formatTime defaultTimeLocale rfc822DateFormat $ ZonedTime (utcToLocalTimeTZ tz time) (rfc822zone $ timeZoneForUTCTime tz time)
   replaceMailHeader "Date" . Just $ pack timeStr
+  where
+    rfc822zone tz'
+      | tz' `elem` rfc822zones = tz'
+      | otherwise              = tz' { timeZoneName = "" }
+    rfc822zones = 
+      [ TimeZone 0         False "UT"
+      , TimeZone 0         False "GMT"
+      , TimeZone (-5 * 60) False "EST"
+      , TimeZone (-4 * 60) True  "EDT"
+      , TimeZone (-6 * 60) False "CST"
+      , TimeZone (-5 * 60) True  "CDT"
+      , TimeZone (-7 * 60) False "MST"
+      , TimeZone (-6 * 60) True  "MDT"
+      , TimeZone (-8 * 60) False "PST"
+      , TimeZone (-7 * 60) True  "PDT"
+      ]
 
 
 setMailSmtpData :: (MonadHandler m, YesodMail (HandlerSite m), MonadThrow m) => MailT m ()
@@ -543,6 +546,3 @@ setMailSmtpData = do
         in tell $ mempty { smtpEnvelopeFrom = Last $ Just verp }
     | otherwise
     -> tell $ mempty { smtpEnvelopeFrom = Last $ Just from }
-
-
-derivePersistFieldJSON ''MailLanguages

src/Model/Migration.hs

@@ -577,6 +577,14 @@ customMigrations = Map.fromListWith (>>)
           ALTER TABLE "allocation" DROP COLUMN "matching_log";
         |]
     )
+  , ( AppliedMigrationKey [migrationVersion|26.0.0|] [version|27.0.0|]
+    , whenM (tableExists "user") $
+        [executeQQ|
+          ALTER TABLE "user" ADD COLUMN "languages" jsonb;
+          UPDATE "user" SET "languages" = "mail_languages" where "mail_languages" <> '[]';
+          ALTER TABLE "user" DROP COLUMN "mail_languages";
+        |]
+    )
   ]
 
 

src/Model/Tokens.hs

@@ -46,7 +46,7 @@ import Data.Binary (Binary)
 data BearerToken site = BearerToken
   { tokenIdentifier   :: TokenId
     -- ^ Unique identifier for each token; maybe useful for tracing usage of tokens
-  , tokenAuthority    :: AuthId site
+  , tokenAuthority    :: Either Value (AuthId site)
     -- ^ Tokens only grant rights the `tokenAuthority` has (i.e. `AuthTag`s are evaluated with the user set to `tokenAuthority`)
   , tokenRoutes       :: Maybe (HashSet (Route site))
     -- ^ Tokens can optionally be restricted to only be usable on a subset of routes
@@ -97,7 +97,7 @@ tokenToJSON :: forall m.
 --
 -- Monadic context is needed because `AuthId`s are encrypted during encoding
 tokenToJSON BearerToken{..} = do
-  cID <- encrypt tokenAuthority :: m (CryptoUUID (AuthId (HandlerSite m)))
+  cID <- either (return . Left) (fmap Right . encrypt) tokenAuthority :: m (Either Value (CryptoUUID (AuthId (HandlerSite m))))
   let stdPayload = Jose.JwtClaims
         { jwtIss = Just $ toPathPiece tokenIssuedBy
         , jwtSub = Nothing
@@ -108,7 +108,7 @@ tokenToJSON BearerToken{..} = do
         , jwtJti = Just $ toPathPiece tokenIdentifier
         }
   return . JSON.object $
-    catMaybes [ Just $ "authority" .= cID
+    catMaybes [ Just $ "authority" .= either id toJSON cID
               , ("routes" .=) <$> tokenRoutes
               , ("add-auth" .=) <$> tokenAddAuth
               , ("restrictions" .=) <$> assertM' (not . HashMap.null) tokenRestrictions
@@ -128,8 +128,8 @@ tokenParseJSON :: forall site.
 --
 -- It's usually easier to use `Utils.Tokens.tokenParseJSON'`
 tokenParseJSON v@(Object o) = do
-  tokenAuthority' <- lift (o .: "authority") :: ReaderT CryptoIDKey Parser (CryptoUUID (AuthId site))
+  tokenAuthority' <- lift $ (Right <$> o .: "authority") <|> (Left <$> o .: "authority") :: ReaderT CryptoIDKey Parser (Either Value (CryptoUUID (AuthId site)))
-  tokenAuthority <- decrypt tokenAuthority'
+  tokenAuthority <- either (return . Left) (fmap Right . decrypt) tokenAuthority'
 
   tokenRoutes        <- lift $ o .:? "routes"
   tokenAddAuth       <- lift $ o .:? "add-auth"

src/Model/Types.hs

@@ -14,3 +14,4 @@ import Model.Types.Submission as Types
 import Model.Types.Misc as Types
 import Model.Types.School as Types
 import Model.Types.Allocation as Types
+import Model.Types.Languages as Types

src/Model/Types/Common.hs

@@ -52,3 +52,5 @@ type InstanceId              = UUID
 type ClusterId               = UUID
 type TokenId                 = UUID
 type TermCandidateIncidence  = UUID
+
+type SessionFileReference    = Digest SHA3_256

src/Model/Types/Languages.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-}
+
+module Model.Types.Languages
+  ( Languages(..)
+  ) where
+
+import ClassyPrelude.Yesod hiding (derivePersistFieldJSON)
+import GHC.Exts (IsList)
+
+import Model.Types.TH.JSON
+
+import Control.Lens.TH (makeWrapped)
+  
+
+newtype Languages = Languages [Lang]
+  deriving (Eq, Ord, Show, Read, Generic, Typeable)
+  deriving newtype (FromJSON, ToJSON, IsList)
+
+instance Default Languages where
+  def = Languages []
+
+instance Hashable Languages
+instance NFData Languages
+derivePersistFieldJSON ''Languages
+makeWrapped ''Languages

src/Model/Types/Security.hs

@@ -21,6 +21,11 @@ import qualified Data.Aeson.Types as Aeson
 
 import qualified Data.Binary as Binary
 
+import qualified Data.CaseInsensitive as CI
+
+import Model.Types.TH.PathPiece
+import Database.Persist.Sql
+
 
 data AuthenticationMode = AuthLDAP
                         | AuthPWHash { authPWHash :: Text }
@@ -152,3 +157,21 @@ instance (Ord a, Binary a) => Binary (PredDNF a) where
 type AuthLiteral = PredLiteral AuthTag
 
 type AuthDNF = PredDNF AuthTag
+
+
+data UserGroupName
+  = UserGroupMetrics
+  | UserGroupCustom { userGroupCustomName :: CI Text }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance PathPiece UserGroupName where
+  toPathPiece UserGroupMetrics = "metrics"
+  toPathPiece (UserGroupCustom t) = CI.original t
+  fromPathPiece t = Just $ if
+    | "metrics" `ciEq` t -> UserGroupMetrics
+    | otherwise          -> UserGroupCustom $ CI.mk t
+    where
+      ciEq = (==) `on` CI.mk
+
+pathPieceJSON ''UserGroupName
+derivePersistFieldPathPiece' (sqlType (Proxy @(CI Text))) ''UserGroupName

src/Model/Types/TH/PathPiece.hs

@@ -1,5 +1,6 @@
 module Model.Types.TH.PathPiece
   ( derivePersistFieldPathPiece
+  , derivePersistFieldPathPiece'
   ) where
 
 import ClassyPrelude.Yesod
@@ -13,7 +14,10 @@ import Language.Haskell.TH.Datatype
 
 
 derivePersistFieldPathPiece :: Name -> DecsQ
-derivePersistFieldPathPiece tName = do
+derivePersistFieldPathPiece = derivePersistFieldPathPiece' SqlString
+
+derivePersistFieldPathPiece' :: SqlType -> Name -> DecsQ
+derivePersistFieldPathPiece' sType tName = do
   DatatypeInfo{..} <- reifyDatatype tName
   vars <- forM datatypeVars (const $ newName "a")
   let t = foldl (\t' n' -> t' `appT` varT n') (conT tName) vars
@@ -32,15 +36,18 @@ derivePersistFieldPathPiece tName = do
         [ 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
+            bs <- newName "bs"
+            clause [[p|PersistDbSpecific $(varP bs)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistDbSpecific") 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 [[p|PersistText $(varP text)|]] (normalB [e|maybe (Left "Could not decode PathPiece from PersistText") Right $ fromPathPiece $(varE text)|]) []
-        , clause [wildP] (normalB [e|Left "PathPiece values must be converted from PersistText or PersistByteString"|]) []
+        , clause [wildP] (normalB [e|Left "PathPiece values must be converted from PersistText, PersistByteString, or PersistDbSpecific"|]) []
         ]
       ]
     , instanceD sqlCxt ([t|PersistFieldSql|] `appT` t)
       [ funD 'sqlType
-        [ clause [wildP] (normalB [e|SqlString|]) []
+        [ clause [wildP] (normalB [e|sType|]) []
         ]
       ]
     ]

src/Prometheus/Instances.hs

@@ -0,0 +1,29 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Prometheus.Instances
+  () where
+
+import ClassyPrelude
+import Prometheus
+import Data.Aeson
+
+import qualified Data.Map.Strict as Map
+
+
+instance ToJSON SampleType where
+  toJSON = String . tshow
+
+instance ToJSON SampleGroup where
+  toJSON (SampleGroup Info{..} sgType samples) = object
+    [ "name" .= metricName
+    , "help" .= metricHelp
+    , "type" .= sgType
+    , "metrics" .= samples
+    ]
+
+instance ToJSON Sample where
+  toJSON (Sample sName sLabels sValue) = object
+    [ "name" .= sName
+    , "labels" .= Map.fromList sLabels
+    , "value" .= decodeUtf8 sValue
+    ]

src/Settings.hs

@@ -126,6 +126,9 @@ data AppSettings = AppSettings
     , appSynchroniseLdapUsersWithin :: Maybe NominalDiffTime
     , appSynchroniseLdapUsersInterval :: NominalDiffTime
 
+    , appSessionFilesExpire     :: NominalDiffTime
+    , appPruneUnreferencedFiles :: Maybe NominalDiffTime
+
     , appInitialLogSettings     :: LogSettings
 
     , appTransactionLogIPRetentionTime :: NominalDiffTime
@@ -417,6 +420,9 @@ instance FromJSON AppSettings where
         appSynchroniseLdapUsersWithin <- o .:? "synchronise-ldap-users-within"
         appSynchroniseLdapUsersInterval <- o .:  "synchronise-ldap-users-interval"
 
+        appSessionFilesExpire     <- o .:  "session-files-expire"
+        appPruneUnreferencedFiles <- o .:? "prune-unreferenced-files"
+
         appMaximumContentLength   <- o .: "maximum-content-length"
 
         appReloadTemplates        <- o .:? "reload-templates" .!= defaultDev