Merge branch 'master' into 574-aktionen-auf-eeusersr

.dir-locals.el

@@ -0,0 +1,5 @@
+;;; Directory Local Variables
+;;; For more information see (info "(emacs) Directory Variables")
+
+((nil
+  (indent-tabs-mode)))

.gitignore

@@ -40,3 +40,5 @@ tunnel.log
 /well-known
 /.well-known-cache
 /**/tmp-*
+/testdata/bigAlloc_*.csv
+/sessions

.gitlab-ci.yml

@@ -203,7 +203,6 @@ hlint:
     - 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
@@ -227,7 +226,6 @@ yesod:test:
     - 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
@@ -249,6 +247,7 @@ deploy:uniworx3:
     - yesod:build
     - yesod:test # For sanity
     - hlint # For sanity
+    - frontend:test # For sanity
   before_script:
     - apt-get update -y
     - apt-get install -y --no-install-recommends openssh-client

CHANGELOG.md

@@ -2,6 +2,393 @@
 
 All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
 
+### [16.0.5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v16.0.4...v16.0.5) (2020-05-06)
+
+
+### Bug Fixes
+
+* **migration:** handle deleted courses & users ([35621df](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/35621df))
+
+
+
+### [16.0.4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v16.0.3...v16.0.4) (2020-05-06)
+
+
+### Bug Fixes
+
+* **migration:** typos ([e508277](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/e508277))
+
+
+
+### [16.0.3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v16.0.2...v16.0.3) (2020-05-05)
+
+
+### Bug Fixes
+
+* **i18n:** s/Typ/Art/ ([0e43851](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0e43851)), closes [#493](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/493)
+* **migration:** typo ([fb7c7ef](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fb7c7ef))
+
+
+
+### [16.0.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v16.0.1...v16.0.2) (2020-05-05)
+
+
+### Bug Fixes
+
+* **corrections-grade-r:** add get following post ([14f9ab6](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/14f9ab6)), closes [#532](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/532)
+* **jobs:** reduce likelihood for multiple queueing of notifications ([970ca78](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/970ca78))
+
+
+
+### [16.0.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v16.0.0...v16.0.1) (2020-05-05)
+
+
+### Bug Fixes
+
+* **exams:** don't show manual bonus as inconsistent ([fb54c84](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fb54c84))
+* **interactive-fieldset:** fix behaviour for nested fieldsets ([65b429a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/65b429a))
+
+
+
+## [16.0.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.6.1...v16.0.0) (2020-05-05)
+
+
+### Features
+
+* **async-table:** history api ([c348b7c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c348b7c)), closes [#426](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/426)
+* **course-participants:** course-deregister-no-show ([bf64eaf](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bf64eaf)), closes [#499](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/499)
+* **course-participants:** introduce CourseParticipantState ([d5b65a1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d5b65a1)), closes [#499](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/499) [#371](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/371)
+* **generic-file-field:** prevent multiple session files of same name ([98e1141](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/98e1141))
+* **http-client:** baseUrl and defaultUrl ([693189f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/693189f))
+* **i18n:** missing translations ([153bb1f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/153bb1f))
+
+
+### BREAKING CHANGES
+
+* **course-participants:** CourseParticipantState
+
+
+
+### [15.6.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.6.0...v15.6.1) (2020-04-30)
+
+
+### Bug Fixes
+
+* **submission-groups:** prevent deleting group before insert ([f87cf7a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f87cf7a))
+
+
+
+## [15.6.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.5.0...v15.6.0) (2020-04-28)
+
+
+### Bug Fixes
+
+* **health:** ldap check only admins ([f889ec6](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f889ec6))
+* **i18n:** submissionDownloadAnonymous ([e6af788](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/e6af788))
+* typo ([52670bc](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/52670bc))
+
+
+### Features
+
+* **corrections:** non-anonymous download w/ registered groups ([9032f80](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9032f80))
+* **sheets:** submission groups & rework sheet form ([57f1ce9](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/57f1ce9))
+* **submission-groups:** invite w/ submission-group & audit ([7f10d44](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7f10d44))
+
+
+
+## [15.5.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.4.1...v15.5.0) (2020-04-27)
+
+
+### Bug Fixes
+
+* **auth:** tutors may see sheet list ([e0c05f3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/e0c05f3))
+* **campus:** fix corner case with study features ([76098cc](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/76098cc))
+
+
+### Features
+
+* **allocations:** switch to csprng ([3ea7371](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3ea7371))
+* **ldap:** failover ([0e68b6c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0e68b6c))
+* **news:** timeout sheets after a month ([31aa25a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/31aa25a))
+
+
+
+### [15.4.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.4.0...v15.4.1) (2020-04-26)
+
+
+### Bug Fixes
+
+* **allocation:** don't restart cloneCount when allocating successors ([e1c6fd4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/e1c6fd4))
+
+
+
+## [15.4.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.3.0...v15.4.0) (2020-04-24)
+
+
+### Bug Fixes
+
+* typo ([c06a472](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c06a472))
+* **faqs:** mention mail to set password ([32097d1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/32097d1))
+* **faqs:** wording ([02d284f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/02d284f))
+* **navbar:** restore border to language buttons ([a2e9a9c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a2e9a9c))
+
+
+### Features
+
+* **faqs:** i18n ([a1a0fa3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a1a0fa3))
+* **faqs:** initial ([7b53377](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7b53377))
+* **faqs:** more faqs ([18766ed](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/18766ed))
+* **faqs:** more links to faq ([10d44d1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/10d44d1))
+* **help:** attach last error message ([fdd6b1a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fdd6b1a))
+
+
+
+## [15.3.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.2.0...v15.3.0) (2020-04-23)
+
+
+### Bug Fixes
+
+* **memcached:** navAccess & quick actions cache invalidations ([d05306a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d05306a))
+* **system-message:** lastChanged & unhide logic error ([36abb3e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/36abb3e))
+
+
+### Features
+
+* **robots.txt:** disallow ahrefs ([9afee89](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9afee89))
+
+
+
+## [15.2.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.1.2...v15.2.0) (2020-04-22)
+
+
+### Bug Fixes
+
+* **health:** more generous healthchecks ([466203d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/466203d))
+
+
+### Features
+
+* **caching:** aggressively cache nav items ([b9b0909](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b9b0909))
+* **memcached:** introduce general purpose memcached ([e8c2dc5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/e8c2dc5))
+
+
+
+### [15.1.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.1.1...v15.1.2) (2020-04-19)
+
+
+### Bug Fixes
+
+* **mass-input:** defaultValue is safe ([03f36ae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/03f36ae))
+
+
+
+### [15.1.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.1.0...v15.1.1) (2020-04-17)
+
+
+### Bug Fixes
+
+* **course-users:** deregistration w/ allocation & w/o reason ([4f237e1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/4f237e1))
+
+
+
+## [15.1.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v15.0.0...v15.1.0) (2020-04-17)
+
+
+### Bug Fixes
+
+* **style:** padding of language buttons ([e704b23](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/e704b23))
+* **tests:** fix build ([b0f2304](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b0f2304))
+
+
+### Features
+
+* **course-user:** authorisation checks ([d15792c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d15792c))
+* **course-user:** i18n ([da629a8](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/da629a8))
+* **course-user:** major improvements ([ced6ef2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ced6ef2)), closes [#126](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/126)
+* **mass-input:** automatic add before submit ([7540a4f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7540a4f))
+* **submissions:** ignore additional filename components ([38f69c3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/38f69c3))
+* **submissions:** non-anonymized correction ([fd2c288](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fd2c288)), closes [#524](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/524) [#292](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/292)
+
+
+
+## [15.0.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.6.0...v15.0.0) (2020-04-15)
+
+
+### Bug Fixes
+
+* **allocations:** better handle participants without applications ([05d37fb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/05d37fb))
+* bump changelog & translate ([a75f3eb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a75f3eb))
+
+
+### Features
+
+* **system-messages:** hiding ([c81bc23](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c81bc23))
+* **system-messages:** refactor cookies & improve system messages ([ead6015](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ead6015))
+
+
+### BREAKING CHANGES
+
+* **system-messages:** names of cookies & configuration changed
+
+
+
+## [14.6.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.5.0...v14.6.0) (2020-04-09)
+
+
+### Bug Fixes
+
+* fix course duplicate message & name -> title for courses ([d87e8b7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d87e8b7))
+* hlint ([908e6de](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/908e6de))
+
+
+### Features
+
+* admin interface to issue tokens ([738ab7b](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/738ab7b))
+
+
+
+## [14.5.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.4.0...v14.5.0) (2020-04-09)
+
+
+### Features
+
+* **news:** show system messages ([0d39924](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0d39924))
+* **tokens:** multiple authorities ([bc47dcf](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bc47dcf))
+
+
+
+## [14.4.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.1.1...v14.4.0) (2020-04-07)
+
+
+### Bug Fixes
+
+* **dbtable:** improve sorting for haskell+sql ([fd8255d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fd8255d))
+* **exam-form:** allow finished without start ([fbc3680](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fbc3680))
+* **exams:** provide bonus information in return of examBonusGrade ([731231d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/731231d))
+* configure sessions to be strictly same-site ([a7e64bc](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a7e64bc))
+* **i18n:** add missing translations ([773c6c5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/773c6c5))
+* fix .dual-heated.degenerate ([6058692](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6058692))
+
+
+### Features
+
+* persist bearer tokens in session ([d8040e7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d8040e7))
+* **allocations:** compute & accept allocations ([20ef95c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/20ef95c))
+* **allocations:** display new allocations in user table ([bb20062](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bb20062))
+* **allocations:** improve accept ui and logging ([3422fd7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3422fd7))
+* **allocations:** improve acceptance display ([cf03277](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cf03277))
+* **allocations:** improve display ([26f8f39](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/26f8f39))
+* **applications-list:** add warning regarding features of study ([cdbe12c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cdbe12c))
+* **course-events:** add HideColumns for course events ([1138f9e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1138f9e))
+* **course-events:** add optional note to course events ([6ad8f2e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6ad8f2e))
+* **course-events:** course event note text -> html ([c8904d1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c8904d1))
+* **course-events:** hide note column if there are no notes to display ([1ac7f4e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1ac7f4e))
+* **course-events:** show notes in course events table ([b2c4125](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b2c4125))
+* **exams:** convenience for automatic grade calculation ([ec6a8ae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ec6a8ae))
+* **serversessions:** move session storage to dedicated memcached ([9960059](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9960059)), closes [#390](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/390)
+* more date & time formats ([936c366](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/936c366))
+
+
+
+## [14.3.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.2.0...v14.3.0) (2020-03-31)
+
+
+### Bug Fixes
+
+* **exam-form:** allow finished without start ([fbc3680](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fbc3680))
+
+
+### Features
+
+* **course-events:** add HideColumns for course events ([1138f9e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1138f9e))
+* **course-events:** add optional note to course events ([6ad8f2e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6ad8f2e))
+* **course-events:** course event note text -> html ([c8904d1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c8904d1))
+* **course-events:** hide note column if there are no notes to display ([1ac7f4e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1ac7f4e))
+* **course-events:** show notes in course events table ([b2c4125](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b2c4125))
+
+
+
+## [14.2.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.1.1...v14.2.0) (2020-03-22)
+
+
+### Bug Fixes
+
+* **dbtable:** improve sorting for haskell+sql ([fd8255d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fd8255d))
+* **exams:** provide bonus information in return of examBonusGrade ([731231d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/731231d))
+* configure sessions to be strictly same-site ([a7e64bc](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a7e64bc))
+* **i18n:** add missing translations ([773c6c5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/773c6c5))
+* fix .dual-heated.degenerate ([6058692](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6058692))
+
+
+### Features
+
+* **allocations:** compute & accept allocations ([20ef95c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/20ef95c))
+* **allocations:** display new allocations in user table ([bb20062](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bb20062))
+* **allocations:** improve accept ui and logging ([3422fd7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3422fd7))
+* **allocations:** improve acceptance display ([cf03277](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cf03277))
+* **allocations:** improve display ([26f8f39](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/26f8f39))
+* **applications-list:** add warning regarding features of study ([cdbe12c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cdbe12c))
+* **exams:** convenience for automatic grade calculation ([ec6a8ae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ec6a8ae))
+* **serversessions:** move session storage to dedicated memcached ([9960059](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9960059)), closes [#390](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/issues/390)
+* more date & time formats ([936c366](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/936c366))
+
+
+
+### [14.1.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.1.0...v14.1.1) (2020-03-06)
+
+
+### Bug Fixes
+
+* **csv-import:** major usability improvements ([2dc6641](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/2dc6641))
+
+
+
+## [14.1.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v14.0.0...v14.1.0) (2020-03-06)
+
+
+### Bug Fixes
+
+* fix build & minor refactor ([bb9b4f0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bb9b4f0))
+* **course-users:** add missing dbt sorting ([1bc14c9](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1bc14c9))
+* **course-users:** insertUnique and only count and audit true inserts ([1325ff2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1325ff2))
+
+
+### Features
+
+* **corrections:** submission filter ([38dbfe7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/38dbfe7))
+* **course-users:** allow for exam registration on CUsersR ([b8acc9b](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b8acc9b))
+* **course-users:** exams in dbtable and csv ([c23becc](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c23becc))
+* **course-users:** filter by exam registrations ([1d7d0ab](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1d7d0ab))
+* **course-users:** match filter titles with column titles ([ecd7bec](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ecd7bec))
+* **course-users:** register exam action with optional occurrence ([34ad1df](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/34ad1df))
+* **csv:** export example data & improve zoned-time parsing ([49d9ab9](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/49d9ab9))
+
+
+
+## [14.0.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v13.0.1...v14.0.0) (2020-03-03)
+
+
+### Bug Fixes
+
+* **allocations:** show assignment green ([9d62b3a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9d62b3a))
+
+
+### Features
+
+* **allocations:** explanations & introduce grade-ordinal-proportion ([ee2e504](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ee2e504))
+* **allocations:** show & export priority ([7462e03](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7462e03))
+* **allocations:** table of allocation users ([2735d46](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/2735d46))
+* **allocations:** tooltips listing courses in users table ([6bca64c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/6bca64c))
+* **allocations:** upload of priorities ([a590f45](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a590f45))
+
+
+### BREAKING CHANGES
+
+* **allocations:** influence of grades on allocation priority now
+relative when priorities are ordinal
+
+
+
 ### [13.0.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v13.0.0...v13.0.1) (2020-02-24)
 
 

config/robots.txt

@@ -1 +1,4 @@
 User-agent: *
+
+User-agent: AhrefsBot
+Disallow: / 

config/settings.yml

@@ -5,7 +5,7 @@
 
 static-dir:     "_env:STATIC_DIR:static"
 well-known-dir: "_env:WELL_KNOWN_DIR:well-known"
-well-known-link-file: "html_code.html"
+well-known-link-file: html_code.html
 
 webpack-manifest: "_env:WEBPACK_MANIFEST:config/webpack.yml"
 host:           "_env:HOST:*4" # any IPv4 host
@@ -31,8 +31,8 @@ notification-rate-limit: 3600
 notification-collate-delay: 7200
 notification-expiration: 259200
 session-timeout: 7200
-jwt-expiration: 604800
+bearer-expiration: 604800
-jwt-encoding: HS256
+bearer-encoding: HS256
 maximum-content-length: "_env:MAX_UPLOAD_SIZE:134217728"
 session-files-expire: 3600
 prune-unreferenced-files: 86400
@@ -67,9 +67,11 @@ ip-retention-time: 1209600
 # Debugging
 auth-dummy-login:  "_env:DUMMY_LOGIN:false"
 allow-deprecated:  "_env:ALLOW_DEPRECATED:false"
+encrypt-errors:    "_env:ENCRYPT_ERRORS:true"
+server-session-acid-fallback: "_env:SERVER_SESSION_ACID_FALLBACK:false"
 
 auth-pw-hash:
-  algorithm: "pbkdf2"
+  algorithm: pbkdf2
   strength: 14
 
 # Optional values with the following production defaults.
@@ -77,7 +79,6 @@ auth-pw-hash:
 # reload-templates: false
 # mutable-static: false
 # skip-combining: false
-# encrypt-errors: true
 
 database:
   user:     "_env:PGUSER:uniworx"
@@ -91,26 +92,28 @@ database:
 auto-db-migrate: '_env:AUTO_DB_MIGRATE:true'
 
 ldap:
-  host:    "_env:LDAPHOST:"
+  - host:    "_env:LDAPHOST:"
-  tls:     "_env:LDAPTLS:"
+    tls:     "_env:LDAPTLS:"
-  port:    "_env:LDAPPORT:389"
+    port:    "_env:LDAPPORT:389"
-  user:    "_env:LDAPUSER:"
+    user:    "_env:LDAPUSER:"
-  pass:    "_env:LDAPPASS:"
+    pass:    "_env:LDAPPASS:"
-  baseDN:  "_env:LDAPBASE:"
+    baseDN:  "_env:LDAPBASE:"
-  scope:   "_env:LDAPSCOPE:WholeSubtree"
+    scope:   "_env:LDAPSCOPE:WholeSubtree"
-  timeout: "_env:LDAPTIMEOUT:5"
+    timeout: "_env:LDAPTIMEOUT:5"
-  search-timeout: "_env:LDAPSEARCHTIME:5"
+    search-timeout: "_env:LDAPSEARCHTIME:5"
-  pool:
+    pool:
-    stripes: "_env:LDAPSTRIPES:1"
+      stripes: "_env:LDAPSTRIPES:1"
-    timeout: "_env:LDAPTIMEOUT:20"
+      timeout: "_env:LDAPTIMEOUT:20"
-    limit:   "_env:LDAPLIMIT:10"
+      limit:   "_env:LDAPLIMIT:10"
+
+ldap-re-test-failover: 60
 
 smtp:
   host:    "_env:SMTPHOST:"
   port:    "_env:SMTPPORT:25"
   ssl:     "_env:SMTPSSL:starttls"
   auth:
-    type:  "login"
+    type:  login
     user:  "_env:SMTPUSER:"
     pass:  "_env:SMTPPASS:"
   pool:
@@ -119,20 +122,65 @@ smtp:
     limit:   "_env:SMTPLIMIT:10"
 
 widget-memcached:
-  host:       "_env:MEMCACHEDHOST:"
+  host:       "_env:WIDGET_MEMCACHED_HOST:"
-  port:       "_env:MEMCACHEDPORT:11211"
+  port:       "_env:WIDGET_MEMCACHED_PORT:11211"
   auth:       []
-  limit:      "_env:MEMCACHEDLIMIT:10"
+  limit:      "_env:WIDGET_MEMCACHED_LIMIT:1024"
-  timeout:    "_env:MEMCACHEDTIMEOUT:20"
+  timeout:    "_env:WIDGET_MEMCACHED_TIMEOUT:20"
-  base-url:   "_env:MEMCACHEDROOT:"
+  base-url:   "_env:WIDGET_MEMCACHED_ROOT:"
-  expiration: "_env:MEMCACHEDEXPIRATION:3600"
+  expiration: "_env:WIDGET_MEMCACHED_EXPIRATION:3600"
+  
+session-memcached:
+  host:       "_env:SESSION_MEMCACHED_HOST:"
+  port:       "_env:SESSION_MEMCACHED_PORT:11211"
+  auth:       []
+  limit:      "_env:SESSION_MEMCACHED_LIMIT:1024"
+  timeout:    "_env:SESSION_MEMCACHED_TIMEOUT:20"
+  expiration: "_env:SESSION_MEMCACHED_EXPIRATION:28807"
+
+memcached:
+  host:       "_env:MEMCACHED_HOST:"
+  port:       "_env:MEMCACHED_PORT:11211"
+  auth:       []
+  limit:      "_env:MEMCACHED_LIMIT:1024"
+  timeout:    "_env:MEMCACHED_TIMEOUT:20"
+  expiration: "_env:MEMCACHED_EXPIRATION:300"
+
+server-sessions:
+  idle-timeout: 28807
+  absolute-timeout: 604801
+  timeout-resolution: 601
+  persistent-cookies: true
+session-token-expiration: 28807
+session-token-encoding: HS256
+
+cookies:
+  SESSION:
+    same-site: lax
+    http-only: true
+    secure: "_env:SERVER_SESSION_COOKIES_SECURE:true"
+  XSRF-TOKEN:
+    expires: null
+    same-site: strict
+    http-only: false
+    secure: "_env:COOKIES_SECURE:true"
+  LANG:
+    expires: 12622780800
+    same-site: lax
+    http-only: false
+    secure: "_env:COOKIES_SECURE:true"
+  SYSTEM-MESSAGE-STATE:
+    expires: 12622780800
+    same-site: lax
+    http-only: false
+    secure: "_env:COOKIES_SECURE:true"
 
 user-defaults:
   max-favourites:      12
   max-favourite-terms: 2
   theme:               Default
   date-time-format:    "%a %d %b %Y %R"
-  date-format:         "%d.%m.%Y"
+  date-format:         "%a %d %b %Y"
   time-format:         "%R"
   download-files:      false
   warning-days:        1209600
@@ -150,3 +198,9 @@ allocation-grade-ordinal-proportion: 0.075
 
 instance-id: "_env:INSTANCE_ID:instance"
 ribbon: "_env:RIBBON:"
+
+
+favourites-quick-actions-burstsize: 40
+favourites-quick-actions-avg-inverse-rate: 50e3 # µs/token
+favourites-quick-actions-timeout: 40e-3 # s
+favourites-quick-actions-cache-ttl: 120 # s

config/test-settings.yml

@@ -4,9 +4,10 @@ database:
 log-settings:
   detailed:      true
   all:           true
-  minimum-level: "debug"
+  minimum-level: debug
-  destination:   "test.log"
+  destination:   test.log
 
 auth-dummy-login: true
+server-session-acid-fallback: true
 
 job-workers: 1

db.sh

@@ -6,4 +6,6 @@ set -e
 [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || :
 
 stack build --fast --flag uniworx:-library-only --flag uniworx:dev
+
+export SERVER_SESSION_ACID_FALLBACK=${SERVER_SESSION_ACID_FALLBACK:-true}
 stack exec uniworxdb -- $@

frontend/src/app.sass

@@ -236,17 +236,15 @@ h4
     margin-top: 20px
 
 // GENERAL BUTTON STYLES
-input[type="submit"],
+input[type="submit"]:not(.btn-link),
-input[type="button"],
+input[type="button"]:not(.btn-link),
-button,
+button:not(.btn-link),
-.btn
+.btn:not(.btn-link)
   font-family: var(--font-base)
   outline: 0
-  border: 0
   box-shadow: 0
   background-color: var(--color-dark)
   color: white
-  padding: 10px 17px
   min-width: 100px
   transition: all .1s
   font-size: 16px
@@ -254,6 +252,10 @@ button,
   display: inline-block
   text-decoration: none
 
+  &:not(.navbar__container-link)
+    padding: 10px 17px
+    border: 0
+
   a:hover
     color: white
 
@@ -264,41 +266,67 @@ button,
 
   .buttongroup > &
     min-width: 0
+    
+  &.btn-danger
+    background-color: var(--color-error-dark)
 
 .buttongroup
   display: grid
   grid: min-content / auto-flow 1fr
 
-input[type="submit"][disabled],
+input[type="submit"][disabled]:not(.btn-link),
-input[type="button"][disabled],
+input[type="button"][disabled]:not(.btn-link),
-button[disabled],
+button[disabled]:not(.btn-link),
-.btn[disabled]
+.btn[disabled]:not(.btn-link)
   opacity: 0.3
   background-color: var(--color-grey)
   cursor: default
 
-input[type="submit"]:not([disabled]):hover,
+input[type="submit"]:not([disabled]):not(.btn-link):hover,
-input[type="button"]:not([disabled]):hover,
+input[type="button"]:not([disabled]):not(.btn-link):hover,
-button:not([disabled]):hover,
+button:not([disabled]):not(.btn-link):hover,
-.btn:not([disabled]):hover
+.btn:not([disabled]):not(.btn-link):hover
   background-color: var(--color-light)
   color: white
 
-.btn-primary
+  &.btn-danger
+    background-color: var(--color-error)
+
+.btn-primary:not(.btn-link)
   background-color: var(--color-primary)
 
-.btn-info
+.btn-info:not(.btn-link)
   background-color: var(--color-info)
 
-.btn--small
+.btn--small:not(.btn-link)
   padding: 4px 7px
   background-color: var(--color-darker)
 
-input[type="submit"].btn-info:hover,
+input[type="submit"].btn-info:not(.btn-link):hover,
-input[type="button"].btn-info:hover,
+input[type="button"].btn-info:not(.btn-link):hover,
-.btn-info:hover
+.btn-info:not(.btn-link):hover
   background-color: var(--color-grey)
 
+.btn-link
+  font-family: var(--font-base)
+  outline: 0
+  border: 0
+  box-shadow: 0
+  background: none
+  color: inherit
+  padding: 0
+  min-width: unset
+  font-size: inherit
+  cursor: pointer
+  display: inline
+  text-decoration: underline
+  font-weight: 600
+  font-style: inherit
+  transition: color .2s ease, background-color .2s ease
+
+  &:not([disabled]):hover
+    color: var(--color-link-hover)
+
 // GENERAL TABLE STYLES
 .table
   margin: 21px 0
@@ -312,11 +340,13 @@ input[type="button"].btn-info:hover,
 
 .table--striped
   .table__row:not(.no-stripe):not(.table__row--sum):nth-child(even)
-    background-color: rgba(0, 0, 0, 0.03)
+    .table__td
+      background-color: rgba(0, 0, 0, 0.03)
 
 .table--hover
   .table__row:not(.no-hover):not(.table__row--sum):not(.table__row--head):not(.table__row--foot):hover
-    background-color: rgba(0, 0, 0, 0.07)
+    .table__td
+      background-color: rgba(0, 0, 0, 0.07)
 
 .table__row--sum td.table__td::before
   content: 'Σ'
@@ -345,6 +375,19 @@ input[type="button"].btn-info:hover,
   padding-right: 10px
   max-width: 300px
 
+.table__td--number
+  width: min-content
+  padding-left: 0
+
+  .table--striped &, .table--hover &
+    vertical-align: middle
+  
+  .table__td-content
+    text-align: right
+    font-size: 0.9rem
+    font-weight: 600
+    color: var(--color-fontsec)
+
 .table__td
   font-size: 16px
   color: var(--color-font)
@@ -390,6 +433,9 @@ input[type="button"].btn-info:hover,
     &.table__th-link::before
       display: none
 
+.table__th--number
+  padding: 0
+
 @media (max-width: 1200px)
   .table th
     padding: 4px 6px
@@ -634,11 +680,27 @@ section
 
 .heated
   --hotness: 0
-  --red: calc(var(--hotness) * 200)
+
-  --green: calc(255 - calc(var(--hotness) * 255))
+  $hue: calc(120 - var(--hotness) * 120)
-  --opacity: calc(calc(var(--red) / 600) + 0.1)
+  $opacity: calc(var(--hotness) * var(--hotness) / 3 + 0.1)
-  font-weight: var(--weight, 600)
+
-  background-color: rgba(var(--red), var(--green), 0, var(--opacity))
+  background-color: hsla($hue, 75%, 50%, $opacity) !important
+  font-weight: calc(var(--hotness) * 200 + 400)
+
+.dual-heated
+   --hotness: 0
+
+   $hue: calc(240 - var(--hotness) * 120)
+   $opacity: calc(((var(--hotness) - 1) * (var(--hotness) - 1)) / 3 + 0.1)
+   
+   background-color: hsla($hue, 75%, 50%, $opacity) !important
+   font-weight: calc(((var(--hotness) - 1) * (var(--hotness) - 1)) * 200 + 400)
+
+   &.degenerate
+     $hue: calc(240 + var(--hotness) * 60)
+   
+     background-color: hsla($hue, 75%, 50%, $opacity) !important
+
 
 .uuid
   font-family: monospace
@@ -791,6 +853,9 @@ th, td
       font-style: normal
       color: var(--color-font)
 
+.course-event-note--hidden
+  display: none
+
 .bound_explanation
   color: var(--color-fontsec)
   font-style: italic
@@ -838,7 +903,7 @@ th, td
   right: 5px
   top: 5px
 
-.occurrence--not-registered, .no-bonus
+.occurrence--not-registered, .no-bonus, .allocation-course--excluded, .allocation-course--inactive
   text-decoration: line-through
 
 .result
@@ -849,11 +914,11 @@ th, td
   dt, .dt
     font-weight: 600
 
-  &.sec
+    &.sec
-    font-style: italic
+      font-style: italic
-    font-size: 0.9rem
+      font-size: 0.9rem
-    font-weight: 600
+      font-weight: 600
-    color: var(--color-fontsec)
+      color: var(--color-fontsec)
 
   dd, .dd
     margin-left: 12px
@@ -861,6 +926,12 @@ th, td
   dd + dt, .dd + dt, dd + .dt, .dd + .dt
     margin-top: 17px
 
+.deflist--no-grid
+  dt, .dt
+    font-weight: 600
+  dd, .dd
+    margin-left: 12px
+
 .explanation
   font-style: italic
   font-size: 0.9rem
@@ -960,6 +1031,9 @@ th, td
   justify-content: space-between
   margin-bottom: 15px
 
+  &:empty
+    margin: 0
+
 // TABLE FOOTER
 .table-footer
   display: flex
@@ -967,6 +1041,9 @@ th, td
   justify-content: space-between
   margin-top: 15px
 
+  &:empty
+    margin: 0
+
 // PAGINATION
 .pagination
   margin-top: 20px
@@ -1136,7 +1213,7 @@ a.breadcrumbs__home
   font-size: 14px
   font-family: monospace
 
-.func-field__wrapper
+.func-field__wrapper, .allocation-missing-prios, .allocation-users__accept
   max-height: 75vh
   overflow: auto
 
@@ -1193,3 +1270,91 @@ a.breadcrumbs__home
   text-align: right
 .text--center
   text-align: center
+
+.course__registration-status
+  margin-bottom: 12px
+
+.csv-parse-error
+  white-space: pre-wrap
+  font-family: monospace
+  overflow: auto
+  max-height: 75vh
+
+.labeled-checkbox
+  display: grid
+  grid-gap: 0 7px
+  grid-template-columns: 20px 1fr
+  grid-template-areas: "checkbox label"
+  
+  &__checkbox
+    grid-area: checkbox
+    place-self: start center
+    line-height: 0
+
+  &__label
+    grid-area: label
+
+.news__system-messages
+  overflow-y: auto
+  max-height: 75vh
+
+.news__system-message-detail
+  font-style: italic
+  font-size: 0.9rem
+  font-weight: 600
+  color: var(--color-fontsec)
+
+  .news__system-message-content + &
+    margin-top: 10px
+
+.news__system-message
+  border-left: 3px solid var(--color-info)
+  padding-left: 17px
+  background-color: rgba(0,0,0,0.015)
+
+  & + .news__system-message
+    margin-top: 17px
+  
+  &--info
+    border-left-color: var(--color-info)
+
+  &--error
+    border-left-color: var(--color-error)
+    
+  &--warning
+    border-left-color: var(--color-warning)
+    
+  &--success
+    border-left-color: var(--color-success)
+
+.faq__question
+  font-size: 18px
+  font-weight: 400
+
+  margin: 0
+
+.faq__answer
+  margin-left: 17px
+
+:not(.show-hide--collapsed) > .faq__answer
+  margin-top: 7px
+
+.faq__section
+  padding-bottom: 10px
+
+  &:last-child, &.show-hide--collapsed
+    border-bottom: none
+    padding-bottom: 0
+
+    & + section:not(.faq__section)
+      border-top: 1px solid #d3d3d3
+      padding-top: 30px
+
+.faq__section + .faq__section
+  margin-top: 10px
+
+.faq__question-link
+  opacity: 0.2
+
+  &:hover
+    opacity: 1

frontend/src/lib/storage-manager/storage-manager.js

@@ -9,9 +9,10 @@ export const LOCATION = {
   LOCAL: 'local',
   SESSION: 'session',
   WINDOW: 'window',
+  HISTORY: 'history',
 };
 
-const LOCATION_SHADOWING = [ LOCATION.WINDOW, LOCATION.SESSION, LOCATION.LOCAL ];
+const LOCATION_SHADOWING = [ LOCATION.HISTORY, LOCATION.WINDOW, LOCATION.SESSION, LOCATION.LOCAL ];
 
 export class StorageManager {
 
@@ -26,7 +27,16 @@ export class StorageManager {
   constructor(namespace, version, options) {
     this._debugLog('constructor', namespace, version, options);
 
-    this.namespace = namespace;
+    if (typeof namespace === 'object') {
+      let sep = '_';
+      const namespace_arr = Array.from(namespace);
+      while (namespace_arr.some(str => str.includes(sep)))
+        sep = sep + '_';
+      
+      this.namespace = Array.from(namespace).join(sep);
+    } else {
+      this.namespace = namespace;
+    }
     this.version = semver.valid(version);
 
     if (!namespace) {
@@ -48,7 +58,7 @@ export class StorageManager {
       throw new Error('Cannot setup StorageManager without window or global');
     
     if (this._options.encryption) {
-      [LOCATION.LOCAL, LOCATION.SESSION].forEach((location) => {
+      [LOCATION.LOCAL, LOCATION.SESSION, LOCATION.HISTORY].forEach((location) => {
         const encryption = this._options.encryption.all || this._options.encryption[location];
         if (encryption) this._requestStorageKey({ location: location, encryption: encryption });
       });
@@ -70,17 +80,21 @@ export class StorageManager {
 
     switch (location) {
       case LOCATION.LOCAL: {
-        this._saveToLocalStorage(this._updateStorage(this._getFromLocalStorage(options), { [key]: value }, LOCATION.LOCAL, options));
+        this._saveToLocalStorage({ ...this._getFromLocalStorage(options), [key]: value}, options);
         break;
       }
       case LOCATION.SESSION: {
-        this._saveToSessionStorage(this._updateStorage(this._getFromSessionStorage(options), { [key]: value }, LOCATION.SESSION, options));
+        this._saveToSessionStorage({ ...this._getFromSessionStorage(options), [key]: value}, options);
         break;
       }
       case LOCATION.WINDOW: {
         this._saveToWindow({ ...this._getFromWindow(), [key]: value });
         break;
       }
+      case LOCATION.HISTORY: {
+        this._saveToHistory({ ...this._getFromHistory(), [key]: value }, options);
+        break;
+      }
       default:
         console.error('StorageManager.save cannot save item with unsupported location');
     }
@@ -112,6 +126,10 @@ export class StorageManager {
           val = this._getFromWindow()[key];
           break;
         }
+        case LOCATION.HISTORY: {
+          val = this._getFromHistory(options)[key];
+          break;
+        }
         default:
           console.error('StorageManager.load cannot load item with unsupported location');
       }
@@ -138,14 +156,14 @@ export class StorageManager {
 
           delete val[key];
 
-          return this._saveToLocalStorage(val);
+          return this._saveToLocalStorage(val, options);
         }
         case LOCATION.SESSION: {
           let val = this._getFromSessionStorage(options);
 
           delete val[key];
 
-          return this._saveToSessionStorage(val);
+          return this._saveToSessionStorage(val, options);
         }
         case LOCATION.WINDOW: {
           let val = this._getFromWindow();
@@ -154,6 +172,14 @@ export class StorageManager {
 
           return this._saveToWindow(val);
         }
+        case LOCATION.HISTORY: {
+          let val = this._getFromHistory(options);
+
+          delete val[key];
+
+          return this._saveToHistory(val, options);
+        }
+
         default:
           console.error('StorageManager.load cannot load item with unsupported location');
       }
@@ -177,6 +203,8 @@ export class StorageManager {
           return this._clearSessionStorage();
         case LOCATION.WINDOW:
           return this._clearWindow();
+        case LOCATION.HISTORY:
+          return this._clearHistory(options && options.history);
         default:
           console.error('StorageManager.clear cannot clear with unsupported location');
       }
@@ -185,7 +213,7 @@ export class StorageManager {
   }
 
   
-  _getFromLocalStorage(options=this._options) {
+  _getFromLocalStorage(options) {
     this._debugLog('_getFromLocalStorage', options);
 
     let state;
@@ -210,7 +238,7 @@ export class StorageManager {
     }
   }
 
-  _saveToLocalStorage(state) {
+  _saveToLocalStorage(state, options) {
     this._debugLog('_saveToLocalStorage', state);
 
     if (!state)
@@ -223,8 +251,8 @@ export class StorageManager {
     } else {
       versionedState = { version: this.version, ...state };
     }
-    
+
-    window.localStorage.setItem(this.namespace, JSON.stringify(versionedState));
+    window.localStorage.setItem(this.namespace, JSON.stringify(this._updateStorage({}, versionedState, LOCATION.LOCAL, options)));
   }
 
   _clearLocalStorage() {
@@ -240,10 +268,10 @@ export class StorageManager {
     if (!this._global || !this._global.App)
       return {};
 
-    if (!this._global.App.Storage)
+    if (!this._global.App.Storage || !this._global.App.Storage[this.namespace])
-      this._global.App.Storage = {};
+      return {};
 
-    return this._global.App.Storage;
+    return this._global.App.Storage[this.namespace];
   }
 
   _saveToWindow(value) {
@@ -274,8 +302,71 @@ export class StorageManager {
     }
   }
 
+  _getFromHistory(options) {
+    this._debugLog('_getFromHistory');
 
-  _getFromSessionStorage(options=this._options) {
+    if (!this._global || !this._global.history)
+      return {};
+
+    if (!this._global.history.state || !this._global.history.state[this.namespace])
+      return {};
+
+    return this._getFromStorage(this._global.history.state[this.namespace], LOCATION.HISTORY, options);
+  }
+
+  _saveToHistory(value, options) {
+    this._debugLog('_saveToHistory', options);
+
+
+    if (!this._global || !this._global.history) {
+      throw new Error('StorageManager._saveToHistory called when window.history is not available');
+    }
+
+    const push = (options.history && typeof options.history.push !== 'undefined') ? !!options.history.push : true;
+    const title = (options.history && options.history.title) || (this._global.document && this._global.document.title) || '';
+    const url = (options.history && options.history.url) || (this._global.document && this._global.document.location);
+    
+    const state = this._global.history.state || {};
+    state[this.namespace] = this._updateStorage({}, value, LOCATION.HISTORY, options);
+
+    this._debugLog('_saveToHistory', { state: state, push: push, title: title, url: url});
+
+    if (push)
+      this._global.history.pushState(state, title, url);
+    else
+      this._global.history.replaceState(state, title, url);
+  }
+
+  _clearHistory(options) {
+    this._debugLog('_clearHistory', options);
+
+    if (!this._global || !this._global.history) {
+      throw new Error('StorageManager._clearHistory called when window.history is not available');
+    }
+
+    const push = (options.history && typeof options.history.push !== 'undefined' ? !!options.history.push : true) || true;
+    const title = (options.history && options.history.title) || (this._global.document && this._global.document.title) || '';
+    const url = (options.history && options.history.url) || (this._global.document && this._global.document.location);
+
+    const state = this._global.history.state || {};
+    delete state[this.namespace];
+
+    if (push)
+      this._global.history.pushState(state, title, url);
+    else
+      this._global.history.replaceState(state, title, url);
+  }
+
+  addHistoryListener(listener, options=this._options, ...args) {
+    const modified_listener = (function(event, ...listener_args) { // eslint-disable-line no-unused-vars
+      this._global.setTimeout(() => listener(this._getFromHistory(options), ...listener_args));
+    }).bind(this);
+
+    this._global.addEventListener('popstate', modified_listener, args);
+  }
+
+
+  _getFromSessionStorage(options) {
     this._debugLog('_getFromSessionStorage', options);
 
     let state;
@@ -300,7 +391,7 @@ export class StorageManager {
     }
   }
 
-  _saveToSessionStorage(state) {
+  _saveToSessionStorage(state, options) {
     this._debugLog('_saveToSessionStorage', state);
 
     if (!state)
@@ -314,7 +405,7 @@ export class StorageManager {
       versionedState = { version: this.version, ...state };
     }
     
-    window.sessionStorage.setItem(this.namespace, JSON.stringify(versionedState));
+    window.sessionStorage.setItem(this.namespace, JSON.stringify(this._updateStorage({}, versionedState, LOCATION.SESSION, options)));
   }
 
   _clearSessionStorage() {
@@ -324,10 +415,10 @@ export class StorageManager {
   }
 
 
-  _getFromStorage(storage, location, options=this._options) {
+  _getFromStorage(storage, location, options) {
     this._debugLog('_getFromStorage', storage, location, options);
 
-    const encryption = options.encryption && (options.encryption.all || options.encryption[location]);
+    const encryption = options && options.encryption && (options.encryption.all || options.encryption[location]);
     if (encryption && storage.encryption) {
       return { ...storage, ...JSON.parse(decrypt(storage.encryption.ciphertext, this._encryptionKey[location]) || null) };
     } else {
@@ -335,10 +426,10 @@ export class StorageManager {
     }
   }
 
-  _updateStorage(storage, update, location, options=this._options) {
+  _updateStorage(storage, update, location, options) {
     this._debugLog('_updateStorage', storage, update, location, options);
 
-    const encryption = options.encryption && (options.encryption.all || options.encryption[location]);
+    const encryption = options && options.encryption && (options.encryption.all || options.encryption[location]);
     if (encryption && storage.encryption) {
       const updatedDecryptedStorage = { ...JSON.parse(decrypt(storage.encryption.ciphertext, this._encryptionKey[location]) || null), ...update };
       console.log('updatedDecryptedStorage', updatedDecryptedStorage);
@@ -357,13 +448,13 @@ export class StorageManager {
     const enc = this.load('encryption', { ...options, encryption: false });
     const requestBody = {
       type      : options.encryption,
-      length    : 42,
+      length    : sodium.crypto_secretbox_KEYBYTES,
       salt      : enc.salt,
       timestamp : enc.timestamp,
     };
 
     this._global.App.httpClient.post({
-      url: '../../../../../../user/storage-key',  // TODO use APPROOT instead
+      url: '/user/storage-key',
       headers: {
         'Content-Type' : HttpClient.ACCEPT.JSON,
         'Accept'       : HttpClient.ACCEPT.JSON,
@@ -381,11 +472,10 @@ export class StorageManager {
     }).catch(console.error);
   }
 
-  _debugLog() {
+  _debugLog() {}
   // _debugLog(fName, ...args) {
-    // console.log(`[DEBUGLOG] StorageManager.${fName}`, { args: args, instance: this });
+  //   console.log(`[DEBUGLOG] StorageManager.${fName}`, { args: args, instance: this });
-  }
+  // }
-
 }
 
 

frontend/src/services/html-helpers/html-helpers.js

@@ -17,7 +17,7 @@ export class HtmlHelpers {
             idPrefix = this._getIdPrefix();
             this._prefixIds(element, idPrefix);
           }
-          return Promise.resolve({ idPrefix, element });
+          return Promise.resolve({ idPrefix, element, headers: response.headers });
         },
         Promise.reject,
       ).catch(console.error);

frontend/src/services/http-client/http-client.js

@@ -15,6 +15,27 @@ export class HttpClient {
     }
   }
 
+  _baseUrl;
+
+  setBaseUrl(baseUrl) {
+    if (typeof this._baseUrl !== 'undefined') {
+      throw new Error('HttpClient baseUrl is already set');
+    }
+
+    this._baseUrl = baseUrl;
+  }
+
+  _defaultUrl;
+
+  setDefaultUrl(defaultUrl) {
+    if (typeof this._defaultUrl !== 'undefined') {
+      throw new Error('HttpClient defaultUrl is already set');
+    }
+
+    this._defaultUrl = defaultUrl;
+  }
+
+
   get(args) {
     args.method = 'GET';
     return this._fetch(args);
@@ -28,12 +49,17 @@ export class HttpClient {
   }
 
   _fetch(options) {
+    options.url = (options.url && options.url.href) || options.url || this._defaultUrl;
+    
+    if (this._baseUrl && options.url && options.url.substring(0,1) === '/' && options.url.substring(0,2) !== '//')
+      options.url = this._baseUrl + (this._baseUrl.substring(this._baseUrl.substring.length - 1) === '/' ? '' : '/') + options.url.substring(1,0);
+    
     const requestOptions = {
       credentials: 'same-origin',
       ...options,
     };
 
-    return fetch(options.url, requestOptions)
+    return fetch(options.url || window.location.href, requestOptions)
       .then(
         (response) => {
           this._responseInterceptors.forEach((interceptor) => interceptor(response, options));

frontend/src/utils/alerts/alerts.js

@@ -155,7 +155,7 @@ export class Alerts {
     alertCloser.classList.add(ALERT_CLOSER_CLASS);
 
     const alertIcon = document.createElement('div');
-    alertIcon.classList.add(ALERT_ICON_CLASS, 'fas', 'fa-fw', 'fa-' + icon);
+    alertIcon.classList.add(ALERT_ICON_CLASS, 'fas', 'fa-' + icon);
 
     const alertContent = document.createElement('div');
     alertContent.classList.add(ALERT_CONTENT_CLASS);

frontend/src/utils/asidenav/asidenav.sass

@@ -232,12 +232,22 @@
 .asidenav__nested-list
   min-width: 200px
 
+.asidenav__nested-list--unavailable
+ font-size: 0.9rem
+ color: var(--color-fontsec)
+ font-weight: 600
+ padding: 7px
+ min-width: 200px
+
 @media (max-width: 425px)
   .asidenav__list-item
     padding-left: 10px
 
   .asidenav__nested-list
     display: none
+    
+  .asidenav__nested-list--unavailable
+    display: none
 
 .asidenav__nested-list-item
   position: relative
@@ -317,10 +327,9 @@
       color: var(--color-font)
       padding: 0
 
-    .asidenav__nested-list,
+    .asidenav__nested-list, .asidenav__link-label, .asidenav__nested-list--unavailable
-    .asidenav__link-label
       display: none
-
+      
     .asidenav__list-item--active
       .asidenav__link-wrapper
         background-color: var(--color-lightwhite)

frontend/src/utils/async-table/async-table.js

@@ -13,7 +13,9 @@ const INPUT_DEBOUNCE = 600;
 const FILTER_DEBOUNCE = 100;
 const HEADER_HEIGHT = 80;
 
-const ASYNC_TABLE_LOCAL_STORAGE_KEY = 'ASYNC_TABLE';
+const ASYNC_TABLE_STORAGE_KEY = 'ASYNC_TABLE';
+const ASYNC_TABLE_STORAGE_VERSION = '2.0.0';
+
 const ASYNC_TABLE_SCROLLTABLE_SELECTOR = '.scrolltable';
 const ASYNC_TABLE_INITIALIZED_CLASS = 'async-table--initialized';
 const ASYNC_TABLE_LOADING_CLASS = 'async-table--loading';
@@ -47,7 +49,10 @@ export class AsyncTable {
   };
   _ignoreRequest = false;
 
-  _storageManager = new StorageManager(ASYNC_TABLE_LOCAL_STORAGE_KEY, '1.0.0', { location: LOCATION.WINDOW });
+  _windowStorage;
+  _historyStorage;
+
+  _active = true;
 
   constructor(element, app) {
     if (!element) {
@@ -79,21 +84,56 @@ export class AsyncTable {
     this._cssIdPrefix = findCssIdPrefix(rawTableId);
     this._asyncTableId = rawTableId.replace(this._cssIdPrefix, '');
 
+    if (!this._asyncTableId) {
+      throw new Error('Async Table cannot be set up without an ident!');
+    }
+
+    this._windowStorage = new StorageManager([ASYNC_TABLE_STORAGE_KEY, this._asyncTableId], ASYNC_TABLE_STORAGE_VERSION, { location: LOCATION.WINDOW });
+    this._historyStorage = new StorageManager([ASYNC_TABLE_STORAGE_KEY, this._asyncTableId], ASYNC_TABLE_STORAGE_VERSION, { location: LOCATION.HISTORY });
+
     // find scrolltable wrapper
     this._scrollTable = this._element.querySelector(ASYNC_TABLE_SCROLLTABLE_SELECTOR);
     if (!this._scrollTable) {
       throw new Error('Async Table cannot be set up without a scrolltable element!');
     }
 
-    this._setupTableFilter();
-
     this._processStorage();
 
-    // clear currentTableUrl from previous requests
+    this._setupTableFilter();
-    this._storageManager.remove('currentTableUrl');
+
+    this._windowStorage.remove('currentTableUrl');
+
+    if (!('currentTableUrl' in this._element.dataset)) {
+      this._element.dataset['currentTableUrl'] = document.location.href;
+      this._historyStorage.save('currentTableUrl', document.location.href, { location: LOCATION.HISTORY, history: { push: false } });
+    }
+
+    this._historyListener();
+
+    this._historyStorage.addHistoryListener(this._historyListener.bind(this));
 
     // mark initialized
-    this._element.classList.add(ASYNC_TABLE_INITIALIZED_CLASS);
+    if (this._active)
+      this._element.classList.add(ASYNC_TABLE_INITIALIZED_CLASS);
+  }
+
+  _historyListener(historyState) {
+    if (!this._active)
+      return;
+    
+    const windowUrl = this._element.dataset['currentTableUrl'];
+    const historyUrl = historyState ? historyState['currentTableUrl'] : this._historyStorage.load('currentTableUrl');
+    this._debugLog('_historyListener', historyState, windowUrl, historyUrl);
+
+    if (this._isEquivalentUrl(windowUrl, historyUrl))
+      return;
+    
+    this._debugLog('_historyListener', historyUrl);
+    this._updateTableFrom(historyUrl || document.location.href, undefined, true);
+  }
+
+  _isEquivalentUrl(a, b) {
+    return a === b;
   }
 
   start() {
@@ -113,7 +153,7 @@ export class AsyncTable {
 
     this._ths.forEach((th) => {
       th.clickHandler = (event) => {
-        this._storageManager.save('horizPos', (this._scrollTable || {}).scrollLeft);
+        this._windowStorage.save('horizPos', (this._scrollTable || {}).scrollLeft);
         this._linkClickHandler(event);
       };
       th.element.addEventListener('click', th.clickHandler);
@@ -135,7 +175,7 @@ export class AsyncTable {
               left: this._scrollTable.offsetLeft || 0,
               behavior: 'smooth',
             };
-            this._storageManager.save('scrollTo', scrollTo);
+            this._windowStorage.save('scrollTo', scrollTo);
           }
           this._linkClickHandler(event);
         };
@@ -256,7 +296,7 @@ export class AsyncTable {
       const prefix = findCssIdPrefix(focusedInput.id);
       const focusId = focusedInput.id.replace(prefix, '');
       callback = function(wrapper) {
-        const idPrefix = this._storageManager.load('cssIdPrefix');
+        const idPrefix = this._windowStorage.load('cssIdPrefix');
         const toBeFocused = wrapper.querySelector('#' + idPrefix + focusId);
         if (toBeFocused) {
           toBeFocused.focus();
@@ -268,34 +308,33 @@ export class AsyncTable {
   }
 
   _serializeTableFilterToURL(tableFilterForm) {
-    const url = new URL(this._storageManager.load('currentTableUrl') || window.location.href);
+    const url = new URL(this._windowStorage.load('currentTableUrl') || window.location.href);
 
     // create new FormData and format any date values
     const formData = Datepicker.unformatAll(tableFilterForm, new FormData(tableFilterForm));
 
-    for (var k of url.searchParams.keys()) {
+    this._debugLog('_serializeTableFilterToURL', Array.from(formData.entries()), url.href);
-      url.searchParams.delete(k);
-    }
 
-    for (var kv of formData.entries()) {
+    const searchParams = new URLSearchParams(Array.from(formData.entries()));
-      url.searchParams.append(kv[0], kv[1]);
+    url.search = searchParams.toString();
-    }
+
+    this._debugLog('_serializeTableFilterToURL', url.href);
 
     return url;
   }
 
   _processStorage() {
-    const scrollTo = this._storageManager.load('scrollTo');
+    const scrollTo = this._windowStorage.load('scrollTo');
     if (scrollTo && this._scrollTable) {
       window.scrollTo(scrollTo);
     }
-    this._storageManager.remove('scrollTo');
+    this._windowStorage.remove('scrollTo');
 
-    const horizPos = this._storageManager.load('horizPos');
+    const horizPos = this._windowStorage.load('horizPos');
     if (horizPos && this._scrollTable) {
       this._scrollTable.scrollLeft = horizPos;
     }
-    this._storageManager.remove('horizPos');
+    this._windowStorage.remove('horizPos');
   }
 
   _removeListeners() {
@@ -330,7 +369,7 @@ export class AsyncTable {
   }
 
   _changePagesizeHandler = () => {
-    const url = new URL(this._storageManager.load('currentTableUrl') || window.location.href);
+    const url = new URL(this._windowStorage.load('currentTableUrl') || window.location.href);
 
     // create new FormData and format any date values
     const formData = Datepicker.unformatAll(this._pagesizeForm, new FormData(this._pagesizeForm));
@@ -347,7 +386,9 @@ export class AsyncTable {
   }
 
   // fetches new sorted element from url with params and replaces contents of current element
-  _updateTableFrom(url, callback) {
+  _updateTableFrom(url, callback, isPopState) {
+    url = new URL(url);
+
     const cancelPendingUpdates = (() => {
       this._cancelPendingUpdates.forEach(f => f());
     }).bind(this);
@@ -372,23 +413,33 @@ export class AsyncTable {
         return false;
       }
 
-      this._storageManager.save('currentTableUrl', url.href);
+      if (!isPopState)
+        this._historyStorage.save('currentTableUrl', url.href, { location: LOCATION.HISTORY, history: { push: true, url: response.headers.get('DB-Table-Canonical-URL') || url.href } });
+      
+      this._windowStorage.save('currentTableUrl', url.href);
       // reset table
       this._removeListeners();
+      this._active = false;
       this._element.classList.remove(ASYNC_TABLE_INITIALIZED_CLASS);
+      this._element.dataset['currentTableUrl'] = url.href;
       // update table with new
       this._element.innerHTML = response.element.innerHTML;
 
       this._app.utilRegistry.initAll(this._element);
 
       if (callback && typeof callback === 'function') {
-        this._storageManager.save('cssIdPrefix', response.idPrefix);
+        this._windowStorage.save('cssIdPrefix', response.idPrefix);
         callback(this._element);
-        this._storageManager.remove('cssIdPrefix');
+        this._windowStorage.remove('cssIdPrefix');
       }
     }).catch((err) => console.error(err)
     ).finally(() => this._element.classList.remove(ASYNC_TABLE_LOADING_CLASS));
   }
+
+  _debugLog() {}
+  // _debugLog(fName, ...args) {
+  //   console.log(`[DEBUGLOG] AsyncTable.${fName}`, { args: args, instance: this });
+  // }
 }
 
 

frontend/src/utils/async-table/async-table.spec.js

@@ -20,6 +20,7 @@ describe('AsyncTable', () => {
     const element = document.createElement('div');
     const scrollTable = document.createElement('div');
     const table = document.createElement('table');
+    table.id = 'ident';
     scrollTable.classList.add('scrolltable');
     scrollTable.appendChild(table);
     element.appendChild(scrollTable);

frontend/src/utils/exam-correct/exam-correct.js

@@ -7,7 +7,6 @@ import moment from 'moment';
 import './exam-correct.sass';
 
 
-const EXAM_CORRECT_URL_POST = 'correct';
 const EXAM_CORRECT_HEADERS = {
   'Content-Type': HttpClient.ACCEPT.JSON,
   'Accept':       HttpClient.ACCEPT.JSON,
@@ -198,7 +197,6 @@ export class ExamCorrect {
     const body = this._toRequestBody(this._userInput.value);
 
     this._app.httpClient.post({
-      url: EXAM_CORRECT_URL_POST,
       headers: EXAM_CORRECT_HEADERS,
       body: JSON.stringify(body),
     }).then(
@@ -290,7 +288,6 @@ export class ExamCorrect {
     const body = this._toRequestBody(userId || user, results, result);
     
     this._app.httpClient.post({
-      url: EXAM_CORRECT_URL_POST,
       headers: EXAM_CORRECT_HEADERS,
       body: JSON.stringify(body),
     }).then(
@@ -522,7 +519,6 @@ export class ExamCorrect {
     const body = this._toRequestBody(listItem.getAttribute(EXAM_CORRECT_USER_ATTR), results.partResults, results.result);
 
     this._app.httpClient.post({
-      url: EXAM_CORRECT_URL_POST,
       headers: EXAM_CORRECT_HEADERS,
       body: JSON.stringify(body),
     }).then(

frontend/src/utils/form/interactive-fieldset.js

@@ -5,10 +5,13 @@ const INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR = '.interactive-fieldset__target
 const INTERACTIVE_FIELDSET_INITIALIZED_CLASS = 'interactive-fieldset--initialized';
 const INTERACTIVE_FIELDSET_CHILD_SELECTOR = 'input:not([disabled]), select:not([disabled]), textarea:not([disabled]), button:not([disabled])';
 
+let fieldsetCounter = 0;
+
 @Utility({
   selector: '[uw-interactive-fieldset]',
 })
 export class InteractiveFieldset {
+  fieldsetIdent = (fieldsetCounter++).toString();
 
   _element;
 
@@ -56,21 +59,23 @@ export class InteractiveFieldset {
       this.target = this._element;
     }
 
-    this.childInputs = Array.from(this._element.querySelectorAll(INTERACTIVE_FIELDSET_CHILD_SELECTOR));
+    this.childInputs = Array.from(this._element.querySelectorAll(INTERACTIVE_FIELDSET_CHILD_SELECTOR)).filter(child => child.closest('[uw-interactive-fieldset]') === this._element);
 
     // add event listener
-    const observer = new MutationObserver(() => this._updateVisibility());
+    const observer = new MutationObserver(this._updateVisibility.bind(this));
     observer.observe(this.conditionalInput, { attributes: true, attributeFilter: ['data-interactive-fieldset-hidden'] });
-    this.conditionalInput.addEventListener('input', () => this._updateVisibility());
+    this.conditionalInput.addEventListener('input', this._updateVisibility.bind(this));
-
-    // initial visibility update
-    this._updateVisibility();
 
     // mark as initialized
     this._element.classList.add(INTERACTIVE_FIELDSET_INITIALIZED_CLASS);
 
   }
 
+  start() {
+    // initial visibility update
+    this._updateVisibility();
+  }
+
   destroy() {
     // TODO
   }
@@ -78,7 +83,20 @@ export class InteractiveFieldset {
   _updateVisibility() {
     const active = this._matchesConditionalValue() && !this.conditionalInput.dataset.interactiveFieldsetHidden;
 
-    this.target.classList.toggle('hidden', !active);
+    let hiddenBy = (this.target.dataset.interactiveFieldsetHiddenBy || '').split(',').filter(str => str.length !== 0);
+
+    if (active)
+      hiddenBy = hiddenBy.filter(ident => ident !== this.fieldsetIdent);
+    else if (hiddenBy.every(ident => ident !== this.fieldsetIdent))
+      hiddenBy = [ ...hiddenBy, this.fieldsetIdent ];
+
+    if (hiddenBy.length !== 0) {
+      this.target.dataset.interactiveFieldsetHiddenBy = hiddenBy.join(',');
+      this.target.classList.add('hidden');
+    } else {
+      delete this.target.dataset['interactiveFieldsetHiddenBy'];
+      this.target.classList.remove('hidden');
+    }
 
     this.childInputs.forEach((el) => this._updateChildVisibility(el, active));
   }
@@ -98,6 +116,9 @@ export class InteractiveFieldset {
 
     if (this._isCheckbox()) {
       matches = this.conditionalInput.checked === true;
+    } else if (this._isRadio()) {
+      const radios = Array.from(this.conditionalInput.querySelectorAll('input[type=radio]'));
+      matches = radios.some(radio => radio.checked && radio.value === this.conditionalValue);
     } else {
       matches = this.conditionalInput.value === this.conditionalValue;
     }
@@ -112,4 +133,8 @@ export class InteractiveFieldset {
   _isCheckbox() {
     return this.conditionalInput.getAttribute('type') === 'checkbox';
   }
+  
+  _isRadio() {
+    return !!this.conditionalInput.querySelector('input[type=radio]');
+  }
 }

frontend/src/utils/hide-columns/hide-columns.sass

@@ -58,5 +58,8 @@
     display: block
     clear: both
 
+  &:empty
+    margin: 0
+
 .hide-columns--hidden-cell
   display: none

frontend/src/utils/inputs/checkbox.sass

@@ -89,7 +89,7 @@
     \:checked + label::before
       background-color: white
 
-  [disabled] + label
+  [disabled] + label, [readonly] + label
     pointer-events: none
     border: none
     opacity: 0.6

frontend/src/utils/inputs/inputs.sass

@@ -60,13 +60,21 @@
     grid-column: 1
 
 .form-group--has-error
-  background-color: rgba(255, 0, 0, 0.1)
+  background-color: rgba(140, 7, 7, 0.05)
+
+  .form-group-label
+    border-left: 2px solid var(--color-error)
+    align-self: stretch
+    padding-left: 7px
 
   input, textarea
     border-color: var(--color-error) !important
 
   .form-error
     display: block
+    font-weight: 600
+    color: var(--color-error)
+    margin: 7px 0
 
 .form-error
   display: none

frontend/src/utils/inputs/radio-group.sass

@@ -4,52 +4,52 @@
 .radio-group
   display: flex
 
-.radio
+  .radio
-  position: relative
+    position: relative
-  display: inline-block
+    display: inline-block
 
-  [type='radio']
+    [type='radio']
-    position: fixed
+      position: fixed
-    top: -1px
+      top: -1px
-    left: -1px
+      left: -1px
-    width: 1px
+      width: 1px
-    height: 1px
+      height: 1px
-    overflow: hidden
+      overflow: hidden
 
-  label
+    label
-    display: block
+      display: block
-    height: 34px
+      height: 34px
-    min-width: 42px
+      min-width: 42px
-    line-height: 34px
+      line-height: 34px
-    text-align: center
+      text-align: center
-    padding: 0 13px
+      padding: 0 13px
-    background-color: #f3f3f3
+      background-color: #f3f3f3
-    box-shadow: inset 2px 1px 2px 1px rgba(50, 50, 50, 0.05)
+      box-shadow: inset 2px 1px 2px 1px rgba(50, 50, 50, 0.05)
-    color: var(--color-font)
+      color: var(--color-font)
-    cursor: pointer
+      cursor: pointer
 
-  \:checked + label
+    \:checked + label
-    background-color: var(--color-primary)
+      background-color: var(--color-primary)
-    color: var(--color-lightwhite)
+      color: var(--color-lightwhite)
-    box-shadow: inset -2px -1px 2px 1px rgba(255, 255, 255, 0.15)
+      box-shadow: inset -2px -1px 2px 1px rgba(255, 255, 255, 0.15)
 
-  \:focus + label
+    \:focus + label
-    border-color: #3273dc
+      border-color: #3273dc
-    box-shadow: 0 0 0.125em 0 rgba(50, 115, 220, 0.8)
+      box-shadow: 0 0 0.125em 0 rgba(50, 115, 220, 0.8)
-    outline: 0
+      outline: 0
 
-  [disabled] + label
+    [disabled] + label
-    pointer-events: none
+      pointer-events: none
-    border: none
+      border: none
-    opacity: 0.6
+      opacity: 0.6
-    filter: grayscale(1)
+      filter: grayscale(1)
 
-.radio:first-child
+  .radio:first-child
-  label
+    label
-    border-top-left-radius: 4px
+      border-top-left-radius: 4px
-    border-bottom-left-radius: 4px
+      border-bottom-left-radius: 4px
 
-.radio:last-child
+  .radio:last-child
-  label
+    label
-    border-top-right-radius: 4px
+      border-top-right-radius: 4px
-    border-bottom-right-radius: 4px
+      border-bottom-right-radius: 4px

frontend/src/utils/inputs/radio.sass

@@ -38,7 +38,7 @@
       box-shadow: 0 0 0.125em 0 rgba(50, 115, 220, 0.8)
       outline: 0
 
-    [disabled] + label
+    [disabled] + label, [readonly] + label
       pointer-events: none
       border: none
       opacity: 0.6

frontend/src/utils/mass-input/mass-input.js

@@ -1,3 +1,5 @@
+/* global global:writable */
+
 import { Utility } from '../../core/utility';
 import { Datepicker } from '../form/datepicker';
 import './mass-input.sass';
@@ -7,6 +9,11 @@ const MASS_INPUT_ADD_CELL_SELECTOR = '.massinput__cell--add';
 const MASS_INPUT_SUBMIT_BUTTON_CLASS = 'massinput__submit-button';
 const MASS_INPUT_INITIALIZED_CLASS = 'mass-input--initialized';
 
+const MASS_INPUT_ADD_CHANGE_FIELD_SELECTOR = 'select, input[type=radio]';
+
+// const MASS_INPUT_SAFETY_SUBMITTED_CLASS = 'massinput--safety-submitted';
+// const MASS_INPUT_SAFETY_SUBMITTED_TIMEOUT = 1000;
+
 @Utility({
   selector: '[uw-mass-input]',
 })
@@ -14,11 +21,14 @@ export class MassInput {
 
   _element;
   _app;
+  _global;
 
   _massInputId;
   _massInputFormSubmitHandler;
   _massInputForm;
 
+  _changedAdd = new Array();
+
   constructor(element, app) {
     if (!element) {
       throw new Error('Mass Input utility cannot be setup without an element!');
@@ -27,6 +37,14 @@ export class MassInput {
     this._element = element;
     this._app = app;
 
+    if (global !== undefined)
+      this._global = global;
+    else if (window !== undefined)
+      this._global = window;
+    else
+      throw new Error('Cannot setup Mass Input utility without window or global');
+
+
     if (this._element.classList.contains(MASS_INPUT_INITIALIZED_CLASS)) {
       return false;
     }
@@ -47,8 +65,10 @@ export class MassInput {
       this._setupSubmitButton(button);
     });
 
-    this._massInputForm.addEventListener('submit', this._massInputFormSubmitHandler);
+    this._massInputForm.addEventListener('submit', this._massInputFormSubmitHandler.bind(this));
-    this._massInputForm.addEventListener('keypress', this._keypressHandler);
+    this._massInputForm.addEventListener('keypress', this._keypressHandler.bind(this));
+
+    Array.from(this._element.querySelectorAll(MASS_INPUT_ADD_CELL_SELECTOR)).forEach(this._setupChangedHandlers.bind(this));
 
     // mark initialized
     this._element.classList.add(MASS_INPUT_INITIALIZED_CLASS);
@@ -58,6 +78,26 @@ export class MassInput {
     this._reset();
   }
 
+  _setupChangedHandlers(addCell) {
+    Array.from(addCell.querySelectorAll(MASS_INPUT_ADD_CHANGE_FIELD_SELECTOR)).forEach(inputElem => {
+      if (inputElem.closest('[uw-mass-input]') !== this._element)
+        return;
+
+      inputElem.addEventListener('change', () => { this._changedAdd.push(addCell); });
+    });
+  }
+
+  _unsafeAddCells() {
+    let changedAdd = this._changedAdd;
+    
+    Array.from(this._element.querySelectorAll(MASS_INPUT_ADD_CELL_SELECTOR)).forEach(addCell => addCell.querySelectorAll('input:not([type=checkbox]):not([type=radio])').forEach(inputElem => {
+      if (inputElem.closest('[uw-mass-input]') === this._element && inputElem.value !== '' && (inputElem.defaultValue || inputElem.getAttribute('value')) !== inputElem.value)
+        changedAdd.push(addCell);
+    }));
+
+    return changedAdd;
+  }
+
   _makeSubmitHandler() {
     const method = this._massInputForm.getAttribute('method') || 'POST';
     const url = this._massInputForm.getAttribute('action') || window.location.href;
@@ -69,31 +109,58 @@ export class MassInput {
     }
 
     return (event) => {
-      let activeElement;
+      let submitButton;
+      let isAddCell;
+      
+      let isMassInputSubmit = (() => {
+        let activeElement;
 
-      // check if event occured from either a mass input add/delete button or
+        // check if event occured from either a mass input add/delete button or
-      // from inside one of massinput's inputs (i.e. a child is focused/active)
+        // from inside one of massinput's inputs (i.e. a child is focused/active)
-      activeElement = this._element.querySelector(':focus, :active');
+        activeElement = this._element.querySelector(':focus, :active');
 
-      if (!activeElement) {
+        if (!activeElement) {
-        return false;
+          return false;
+        }
+
+        // find the according massinput cell thats hosts the element that triggered the submit
+        const massInputCell = activeElement.closest(MASS_INPUT_CELL_SELECTOR);
+        if (!massInputCell) {
+          return false;
+        }
+
+        submitButton = massInputCell.querySelector('.' + MASS_INPUT_SUBMIT_BUTTON_CLASS);
+        if (!submitButton) {
+          return false;
+        }
+
+        isAddCell = massInputCell.matches(MASS_INPUT_ADD_CELL_SELECTOR);
+        const submitButtonIsActive = submitButton.matches(':focus, :active');
+        // if the cell is not an add cell the active element must at least be the cells submit button
+        if (!isAddCell && !submitButtonIsActive) {
+          return false;
+        }
+
+        return true;
+      })();
+      
+      let unsafeAddCells = this._unsafeAddCells();
+
+      if (unsafeAddCells.length > 0 && !isMassInputSubmit) {
+        let addButtons = Array.from(unsafeAddCells[0].querySelectorAll('.' + MASS_INPUT_SUBMIT_BUTTON_CLASS)).filter(addButton => addButton.closest('[uw-mass-input]') === this._element);
+
+        if (addButtons.length > 0) {
+          submitButton = addButtons[0];
+          isMassInputSubmit = true;
+          isAddCell = false;
+
+          this._element.scrollIntoView();
+          // this._element.classList.add(MASS_INPUT_SAFETY_SUBMITTED_CLASS);
+          // this._global.setTimeout(() => { this._element.classList.remove(MASS_INPUT_SAFETY_SUBMITTED_CLASS) }, MASS_INPUT_SAFETY_SUBMITTED_TIMEOUT)
+        }
       }
 
-      // find the according massinput cell thats hosts the element that triggered the submit
+      if (!isMassInputSubmit) {
-      const massInputCell = activeElement.closest(MASS_INPUT_CELL_SELECTOR);
-      if (!massInputCell) {
-        return false;
-      }
-
-      const submitButton = massInputCell.querySelector('.' + MASS_INPUT_SUBMIT_BUTTON_CLASS);
-      if (!submitButton) {
-        return false;
-      }
-
-      const isAddCell = massInputCell.matches(MASS_INPUT_ADD_CELL_SELECTOR);
-      const submitButtonIsActive = submitButton.matches(':focus, :active');
-      // if the cell is not an add cell the active element must at least be the cells submit button
-      if (!isAddCell && !submitButtonIsActive) {
         return false;
       }
 

frontend/src/utils/mass-input/mass-input.sass

@@ -1,3 +1,5 @@
+@use "../../app" as *
+  
 .massinput-list__wrapper, .massinput-list__cell
   display: grid
   grid: auto / auto 50px
@@ -12,3 +14,14 @@
 
 .massinput-list__cell
   grid-column: 1 / 3
+
+/* .massinput--safety-submitted
+/*   animation: massinput--safety-submitted linear 1s
+
+/* @keyframes massinput--safety-submitted
+/*   0%
+/*     background-color: rgba(252, 153, 0, 0)
+/*   50%
+/*     background-color: rgba(252, 153, 0, 0.8)
+/*   100%
+/*     background-color: rgba(252, 153, 0, 0)

frontend/src/utils/show-hide/show-hide.js

@@ -57,23 +57,44 @@ export class ShowHide {
       this._element.classList.add(SHOW_HIDE_TOGGLE_RIGHT_CLASS);
     }
 
+    this._checkHash();
+
+    window.addEventListener('hashchange', this._checkHash.bind(this));
+
     // mark as initialized
     this._element.classList.add(SHOW_HIDE_INITIALIZED_CLASS, SHOW_HIDE_TOGGLE_CLASS);
   }
 
-  destroy() {
+  destroy() {}
-    this._element.removeEventListener('click', this._clickHandler);
-  }
 
   _addClickListener() {
-    this._element.addEventListener('click', this._clickHandler);
+    this._element.addEventListener('click', this._clickHandler.bind(this));
   }
 
-  _clickHandler = () => {
+  _show() {
-    const newState = this._element.parentElement.classList.toggle(SHOW_HIDE_COLLAPSED_CLASS);
+    this._element.parentElement.classList.remove(SHOW_HIDE_COLLAPSED_CLASS); 
+  }
+
+  _toggle() {
+    return this._element.parentElement.classList.toggle(SHOW_HIDE_COLLAPSED_CLASS); 
+  }
+
+  _clickHandler(event) {
+    if (event.target.closest('a') && event.target.closest('a') !== this._element)
+      return;
+    if (event.target.matches('a') && event.target !== this._element)
+      return;
+    
+    const newState = this._toggle();
 
     if (this._showHideId) {
       this._storageManager.save(this._showHideId, newState);
     }
   }
+
+  _checkHash() {
+    if (this._element.id && '#' + this._element.id === location.hash) {
+      this._show();
+    }
+  }
 }

frontend/src/utils/show-hide/show-hide.sass

@@ -19,7 +19,7 @@ $show-hide-toggle-size: 6px
   border-right: 2px solid currentColor
   border-top: 2px solid currentColor
   transition: transform .2s ease
-  transform: translateY(-50%) rotate(-45deg)
+  transform: translateY(2px) translateY(-50%) rotate(-45deg)
 
   @media (max-width: 768px)
     left: auto
@@ -33,7 +33,7 @@ $show-hide-toggle-size: 6px
 
 .show-hide--collapsed
   .show-hide__toggle::before
-    transform: translateY(-50%) rotate(135deg)
+    transform: translateY(-2px) translateY(-50%) rotate(135deg)
 
   & > :not(.show-hide__toggle)
     display: block

ghci.sh

@@ -4,10 +4,16 @@ set -e
 
 [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || :
 
+export DETAILED_LOGGING=${DETAILED_LOGGING:-true}
+export LOG_ALL=${LOG_ALL:-false}
+export LOGLEVEL=${LOGLEVEL:-info}
+export DUMMY_LOGIN=${DUMMY_LOGIN:-true}
+export SERVER_SESSION_ACID_FALLBACK=${SERVER_SESSION_ACID_FALLBACK:-true}
+export SERVER_SESSION_COOKIES_SECURE=${SERVER_SESSION_COOKIES_SECURE:-false}
+export ALLOW_DEPRECATED=${ALLOW_DEPRECATED:-true}
+export RIBBON=${RIBBON:-${__HOST:-localhost}}
 unset HOST
-export DETAILED_LOGGING=true
+
-export LOG_ALL=true
-export DUMMY_LOGIN=true
 
 move-back() {
     mv -v .stack-work .stack-work-ghci

messages/faq/de-de-formal.msg

@@ -0,0 +1,5 @@
+FAQNoCampusAccount: Ich habe keine LMU-Benutzerkennung (ehem. Campus-Kennung); kann ich trotzdem Zugang zum System erhalten?
+FAQForgottenPassword: Ich habe mein Passwort vergessen
+FAQCampusCantLogin: Ich kann mich mit meiner LMU-Benutzerkennung (ehem. Campus-Kennung) nicht anmelden
+FAQCourseCorrectorsTutors: Wie kann ich Tutoren oder Korrektoren für meinen Kurs einstellen?
+FAQNotLecturerHowToCreateCourses: Wie kann ich einen neuen Kurs anlegen?

messages/faq/en-eu.msg

@@ -0,0 +1,5 @@
+FAQNoCampusAccount: I don't have a LMU user ID (formerly Campus-ID); can I still get access to Uni2work?
+FAQForgottenPassword: I have forgotten my password
+FAQCampusCantLogin: I can't log in using my LMU user ID (formerly Campus-ID)
+FAQCourseCorrectorsTutors: How can I add tutors or correctors to my course?
+FAQNotLecturerHowToCreateCourses: How can I create new courses?

messages/uniworx/de-de-formal.msg

@@ -32,6 +32,10 @@ BtnLecInvDecline: Ablehnen
 BtnCorrInvAccept: Annehmen
 BtnCorrInvDecline: Ablehnen
 BtnSubmissionsAssign: Abgaben automatisch zuteilen
+BtnAllocationCompute: Vergabe berechnen
+BtnAllocationAccept: Vergabe akzeptieren
+BtnSystemMessageHide: Verstecken
+BtnSystemMessageUnhide: Nicht mehr verstecken
 
 
 Aborted: Abgebrochen
@@ -116,11 +120,12 @@ CourseStudyFeatureTip: Dient ausschließlich der Information der Kursverwalter
 CourseStudyFeatureUpdated: Assoziiertes Studienfach geändert
 CourseStudyFeatureNone: Kein assoziiertes Studienfach
 CourseTutorial: Tutorium
+CourseExam: Prüfung
 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 und Institut.
+CourseNewDupShort  tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{tid}-#{ssh}-#{csh} konnte nicht erstellt werden: Es gibt bereits einen anderen Kurs mit dem selben Kürzel oder Titel 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 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 selben Kürzel oder Titel in diesem Semester und Institut.
 FFSheetName: Name
 TermCourseListHeading tid@TermId: Kursübersicht #{tid}
 TermSchoolCourseListHeading tid@TermId school@SchoolName: Kursübersicht #{tid} für #{school}
@@ -136,7 +141,7 @@ CourseAssociatedWith: assoziiert mit
 CourseMembersCount n@Int: #{n}
 CourseMembersCountLimited n@Int max@Int: #{n}/#{max}
 CourseMembersCountOf n@Int mbNum@IntMaybe: #{n} Kursanmeldungen #{maybeToMessage " von " mbNum " möglichen"}
-CourseName: Name
+CourseName: Kurstitel
 CourseDescription: Beschreibung
 CourseHomepageExternal: Externe Homepage
 CourseShorthand: Kürzel
@@ -157,7 +162,13 @@ CourseFilterNone: —
 BoolIrrelevant: —
 CourseDeleteQuestion: Wollen Sie den unten aufgeführten Kurs wirklich löschen?
 CourseDeleted: Kurs gelöscht
+CourseUserTutorial: Angemeldetes Tutorium
 CourseUserTutorials: Angemeldete Tutorien
+CourseUserExam: Angemeldete Prüfung
+CourseUserExams: Angemeldete Prüfungen
+CourseSingleUserExams: Prüfungen
+CourseSingleUserTutorials: Tutorien
+CourseUserCorrections: Abgaben
 CourseUserNote: Notiz
 CourseUserNoteTooltip: Nur für Verwalter dieses Kurses einsehbar
 CourseUserNoteSaved: Notizänderungen gespeichert
@@ -166,7 +177,9 @@ CourseUserRegister: Zum Kurs anmelden
 CourseUserDeregister: Vom Kurs abmelden
 CourseUsersDeregistered count@Int64: #{show count} Teilnehmer vom Kurs abgemeldet
 CourseUserRegisterTutorial: Zu einem Tutorium anmelden
+CourseUserRegisterExam: Zu einer Prüfung anmelden
 CourseUsersTutorialRegistered count@Int64: #{show count} Teilnehmer zum Tutorium angemeldet
+CourseUsersExamRegistered count@Int64: #{show count} Teilnehmer zur Prüfung angemeldet
 CourseUserSendMail: Mitteilung verschicken
 TutorialUserDeregister: Vom Tutorium Abmelden
 TutorialUserSendMail: Mitteilung verschicken
@@ -311,15 +324,19 @@ SheetSolutionFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren könn
 SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren
 SheetPseudonym: Persönliches Abgabe-Pseudonym
 SheetGeneratePseudonym: Generieren
+SheetAnonymousCorrection: Anonymisierte Korrektur
+SheetAnonymousCorrectionTip: Wenn die Korrektur anonymisiert erfolgt, können Korrektoren die ihnen zugeteilten Abgaben nicht bestimmten Studierenden zuordnen (Name, Matrikelnummer und feste Abgabegruppe der Abgebenden werden versteckt) 
 
 SheetFormType: Wertung & Abgabe
 SheetFormTimes: Zeiten
 SheetFormFiles: Dateien
 
-SheetErrVisibility: "Beginn Abgabezeitraum" muss nach "Sichbar für Teilnehmer ab" liegen
+SheetErrVisibility: "Aktiv ab/Beginn Abgabezeitraum" muss nach "Sichbar für Teilnehmer ab" liegen
-SheetErrDeadlineEarly: "Ende Abgabezeitraum" muss nach "Beginn Abzeitraum" liegen
+SheetErrDeadlineEarly: "Aktiv bis/Ende Abgabezeitraum" muss nach "Aktiv ab/Beginn Abzeitraum" liegen
 SheetErrHintEarly: Hinweise dürfen erst nach Beginn des Abgabezeitraums herausgegeben werden
 SheetErrSolutionEarly: Lösungen dürfen erst nach Ende der Abgabezeitraums herausgegeben werden
+SheetErrVisibleWithoutActive: Wird "Sichtbar für Teilnehmer ab" angegeben, muss auch "Aktiv ab/Beginn Abgabezeitraum" angegeben werden
+SheetWarnNoActiveTo: "Aktiv bis/Ende Abgabezeitraum" sollte stets angegeben werden
 SheetNoCurrent: Es gibt momentan kein aktives Übungsblatt.
 SheetNoOldUnassigned: Alle Abgaben inaktiver Blätter sind bereits einen Korrektor zugeteilt.
 SheetsUnassignable name@Text: Momentan keine Abgaben zuteilbar für #{name}
@@ -395,6 +412,7 @@ UnauthorizedTokenExpired: Ihr Authorisierungs-Token ist abgelaufen.
 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.
+UnauthorizedTokenInvalidNoAuthority: Ihr Authorisierungs-Token nennt keine Nutzer, auf deren Rechten es basiert.
 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.
@@ -458,6 +476,8 @@ UnauthorizedLDAP: Angegebener Nutzer meldet sich nicht mit Campus-Kennung an.
 UnauthorizedPWHash: Angegebener Nutzer meldet sich nicht mit Uni2work-Kennung an.
 UnauthorizedExternalExamListNotEmpty: Liste von externen Prüfungen ist nicht leer
 UnauthorizedExternalExamLecturer: Sie sind nicht als Prüfer für diese externe Prüfung eingetragen
+UnauthorizedSubmissionSubmissionGroup: Sie sind nicht Mitglied in einer der registrierten Abgabegruppen, die an dieser Abgabe beteiligt sind
+UnauthorizedSheetSubmissionGroup: Sie sind nicht Mitglied in einer registrierten Abgabegruppe
 
 UnauthorizedPasswordResetToken: Dieses Authorisierungs-Token kann nicht mehr zum Passwort ändern benutzt werden
 
@@ -514,11 +534,17 @@ NewsOpenAllocations: Offene Zentralanmeldungen
 NewsUpcomingSheets: Anstehende Übungsblätter
 NewsUpcomingExams: Bevorstehende Prüfungen
 
+NewsHideHiddenSystemMessages: Versteckte Nachrichten nicht mehr anzeigen
+NewsShowHiddenSystemMessages: Versteckte Nachrichten anzeigen
+
 NumCourses num@Int64: #{num} #{pluralDE num "Kurs" "Kurse"}
 CloseAlert: Schliessen
 
 Name: Name
 MatrikelNr: Matrikelnummer
+Surname: Nachname(n)
+FirstName: Vorname(n)
+Title: Titel
 LdapSynced: LDAP-Synchronisiert
 LdapSyncedBefore: Letzte LDAP-Synchronisation vor
 NoMatrikelKnown: Keine Matrikelnummer
@@ -545,6 +571,12 @@ DBTablePagesize: Einträge pro Seite
 DBTablePagesizeAll: Alle
 
 CorrDownload: Herunterladen
+CorrDownloadAnonymous: Anonymisiert
+CorrDownloadAnonymousTip: Wenn Abgaben nicht-anonymisiert heruntergeladen werden, werden an die Verzeichnisnamen der einzelnen Abgaben das ausgewählte Merkmal der Abgeber angehängt, sofern erlaubt 
+SubmissionDownloadAnonymous: Anonymisiert
+SubmissionDownloadSurnames: Mit Nachnamen
+SubmissionDownloadMatriculations: Mit Matrikelnummern
+SubmissionDownloadGroups: Mit festen Abgabegruppen
 CorrUploadField: Korrekturen
 CorrUpload: Korrekturen hochladen
 CorrSetCorrector: Korrektor zuweisen
@@ -747,7 +779,7 @@ UploadModeAny: Upload, beliebige Datei(en)
 UploadModeSpecific: Upload, vorgegebene Dateinamen
 
 UploadModeUnpackZips: Abgabe mehrerer Dateien
-UploadModeUnpackZipsTip: Wenn die Abgabe mehrerer Dateien erlaubt ist, werden auch unterstützte Archiv-Formate zugelassen. Diese werden nach dann beim Hochladen automatisch entpackt.
+UploadModeUnpackZipsTip: Wenn die Abgabe mehrerer Dateien erlaubt ist, werden auch unterstützte Archiv-Formate zugelassen. Diese werden dann beim Hochladen automatisch entpackt.
 
 AutoUnzip: ZIPs automatisch entpacken
 AutoUnzipInfo: Entpackt hochgeladene ZIP-Dateien (*.zip) automatisch und fügt den Inhalt dem Stamm-Verzeichnis hinzu.
@@ -756,6 +788,9 @@ UploadModeExtensionRestriction: Zulässige Dateiendungen
 UploadModeExtensionRestrictionTip: Komma-separiert. Wenn keine Dateiendungen angegeben werden erfolgt keine Einschränkung.
 UploadModeExtensionRestrictionEmpty: Liste von zulässigen Dateiendungen darf nicht leer sein
 
+GenericFileFieldInvalidExtension file@FilePath: „#{file}” hat keine zulässige Dateiendung
+FileUploadOnlySessionTip: Sie haben diese Datei in der aktuellen Session bereits hochgeladen, sie ist allerdings noch nicht gespeichert. Sie müssen zunächst noch das Formular „Senden“, damit die Datei ordnungsgemäß gespeichert wird.
+
 UploadSpecificFiles: Vorgegebene Dateinamen
 NoUploadSpecificFilesConfigured: Wenn der Abgabemodus vorgegebene Dateinamen vorsieht, muss mindestens ein vorgegebener Dateiname konfiguriert werden.
 UploadSpecificFilesDuplicateNames: Vorgegebene Dateinamen müssen eindeutig sein
@@ -769,6 +804,8 @@ CorrectorSubmissions: Abgabe extern mit Pseudonym
 UserSubmissions: Direkte Abgabe in Uni2work
 BothSubmissions: Abgabe direkt in Uni2work & extern mit Pseudonym
 
+BothSubmissionsTip: Abgabe kann, nach Wahl des Teilnehmers, entweder direkt in Uni2work oder extern mit Pseudonym erfolgen
+
 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.
 
 SubmissionNoUploadExpected: Es ist keine Abgabe von Dateien vorgesehen.
@@ -947,8 +984,9 @@ SheetGradingPassBinary': Bestanden/Nicht bestanden
 
 SheetTypeBonus grading@SheetGrading: Bonus
 SheetTypeNormal grading@SheetGrading: Normal
-SheetTypeInformational grading@SheetGrading: Ohne Anrechung
+SheetTypeInformational grading@SheetGrading: Ohne Anrechnung
 SheetTypeNotGraded: Keine Korrektur
+SheetTypeInfoNormalLecturer: Normale Blätter werden zur Berechnung eines etwaigen Klausurbonus herangezogen. Der Bonus kann sowohl anhand der zu bestehenden Blätter als auch der erreichbaren Maximalpunktzahl automatisch oder manuell berechnet werden.
 SheetTypeInfoNotGraded: Keine Korrektur bedeutet, dass es gar kein Feedback gibt.
 SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter.
 SheetTypeInfoInformational: Blätter ohne Anrechnung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information der Teilnehmer.
@@ -1051,10 +1089,23 @@ HelpRequest: Supportanfrage / Verbesserungsvorschlag
 HelpProblemPage: Problematische Seite
 HelpIntroduction: Wenn Ihnen die Benutzung dieser Webseite Schwierigkeiten bereitet oder Sie einen verbesserbaren Umstand entdecken bitten wir Sie uns das zu melden, auch wenn Sie Ihr Problem bereits selbst lösen konnten. Wir passen die Seite ständig an und versuchen sie auch für zukünftige Benutzer so einsichtig wie möglich zu halten.
 HelpSent: Ihre Supportanfrage wurde weitergeleitet.
+HelpSendLastError: Letzte Fehlermeldung anhängen
+HelpError: Letzte Fehlermeldung
+HelpErrorYamlFilename mailId@MailObjectId: fehlermeldung-#{toPathPiece mailId}.yaml
+HelpErrorOrRequestRequired: Bitte geben Sie entweder eine Supportanfrage bzw. einen Verbesserungsvorschlag an oder hängen Sie die letzte Fehlermeldung an
 
 InfoLecturerTitle: Hinweise für Veranstalter
 
 
+SystemMessageNewsOnly: Nur auf "Aktuelles"
+SystemMessageRecordChanged: Signifikante Änderung
+SystemMessageRecordChangedTip: Soll der "zuletzt geändert"-Zeitstempel gesetzt werden? Nachrichten werden auf "Aktuelles" danach sortiert und bei signifikanten Änderungen erneut als Benachrichtigung unten rechts angezeigt.
+SystemMessageUnhide: "Verstecken" ignorieren
+SystemMessageUnhideTip: Soll die Nachricht für Benutzer, die sie aktiv versteckt haben, erneut angezeigt werden?
+SystemMessageCreated: Erstellt
+SystemMessageLastChanged: Zuletzt geändert
+SystemMessageLastChangedAt time@Text: Zuletzt geändert: #{time}
+SystemMessageLastUnhide: Zuletzt un-versteckt
 SystemMessageFrom: Sichtbar ab
 SystemMessageTo: Sichtbar bis
 SystemMessageAuthenticatedOnly: Nur angemeldet
@@ -1147,6 +1198,7 @@ MenuUserPassword: Passwort
 MenuAdminTest: Admin-Demo
 MenuMessageList: Systemnachrichten
 MenuAdminErrMsg: Fehlermeldung entschlüsseln
+MenuAdminTokens: Tokens ausstellen
 MenuProfileData: Persönliche Daten
 MenuTermCreate: Neues Semester anlegen
 MenuCourseNew: Neuen Kurs anlegen
@@ -1214,6 +1266,9 @@ MenuParticipantsList: Kursteilnehmerlisten
 MenuParticipantsIntersect: Überschneidung von Kursteilnehmern
 MenuAllocationUsers: Bewerber
 MenuAllocationPriorities: Zentrale Dringlichkeiten
+MenuAllocationCompute: Platzvergabe berechnen
+MenuAllocationAccept: Platzvergabe akzeptieren
+MenuFaq: FAQ
 
 BreadcrumbSubmissionFile: Datei
 BreadcrumbSubmissionUserInvite: Einladung zur Abgabe
@@ -1281,6 +1336,10 @@ BreadcrumbExamAutoOccurrence: Automatische Termin-/Raumverteilung
 BreadcrumbStorageKey: Lokalen Schlüssel generieren
 BreadcrumbAllocationUsers: Bewerber
 BreadcrumbAllocationPriorities: Zentrale Dringlichkeiten
+BreadcrumbAllocationCompute: Platzvergabe berechnen
+BreadcrumbAllocationAccept: Platzvergabe akzeptieren
+BreadcrumbMessageHide: Verstecken
+BreadcrumbFaq: FAQ
 
 ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn}
 ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn}
@@ -1331,6 +1390,7 @@ AuthTagIsPWHash: Nutzer meldet sich mit Uni2work-Kennung an
 AuthTagAuthentication: Nutzer ist angemeldet, falls erforderlich
 AuthTagRead: Zugriff ist nur lesend
 AuthTagWrite: Zugriff ist i.A. schreibend
+AuthTagSubmissionGroup: Nutzer ist Mitglied in registrierter Abgabegruppe
 
 DeleteCopyStringIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, schreiben Sie bitte zunächst den angezeigten Text ab.
 DeletePressButtonIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, bestätigen Sie dies bitte durch Drücken des untigen Knopfes.
@@ -1460,7 +1520,7 @@ ExceptionKindNoOccur: Findet nicht statt
 ExceptionExists: Diese Ausnahme existiert bereits
 ExceptionNoOccurAt: Termin
 
-TutorialType: Typ
+TutorialType: Art
 TutorialTypePlaceholder: Tutorium, Zentralübung, ...
 TutorialTypeTip: Dient nur der Information der Studierenden
 TutorialName: Bezeichnung
@@ -1681,6 +1741,7 @@ ExamRegistered: Zur Prüfung angemeldet
 ExamNotRegistered: Nicht zur Prüfung angemeldet
 ExamRegistration: Prüfungsanmeldung
 ExamLoginToRegister: Um sich zum Kurs anzumelden müssen Sie zunächst in Uni2work anmelden
+ExamRegistrationTime: Angemeldet seit
 
 ExamRegisterToMustBeAfterRegisterFrom: "Anmeldung ab" muss vor "Anmeldung bis" liegen
 ExamDeregisterUntilMustBeAfterRegisterFrom: "Abmeldung bis" muss nach "Anmeldung bis" liegen
@@ -1720,6 +1781,20 @@ ExamUsersResultsReset count@Int64: Prüfungsergebnis für #{show count} Teilnehm
 ExamUsersPartResultsSet count@Int64: Teilprüfungsergebnis für #{show count} Teilnehmer angepasst
 ExamUsersBonusSet count@Int64: Bonuspunkte für #{show count} Teilnehmer angepasst
 ExamUsersResultSet count@Int64: Prüfungsergebnis für #{show count} Teilnehmer angepasst
+CourseUserTutorialsDeregistered count@Int64: Teilnehmer von #{show count} #{pluralDE count "Tutorium" "Tutorien"} abgemeldet
+CourseUserNoTutorialsDeregistered: Teilnehmer ist zu keinem der gewählten Tutorien angemeldet
+CourseUserExamsDeregistered count@Int64: Teilnehmer von #{show count} #{pluralDE count "Prüfung" "Prüfungen"} abgemeldet
+CourseUserNoExamsDeregistered: Teilnehmer ist zu keiner der gewählten Prüfungen angemeldet
+CourseUserExamsResultSet count@Int64: Ergebnis zu #{show count} #{pluralDE count "Prüfung" "Prüfungen"} erfolgreich angepasst
+CourseUserExamResultDoesNotMatchMode examn@ExamName: Gewähtes Ergebnis passt nicht zu Bewertungsmodus von Prüfung „#{examn}“.
+CourseUserSetSubmissionGroup: Feste Abgabegruppe setzen/entfernen
+CourseUsersSubmissionGroupSetNew count@Int64: #{show count} Benutzer der festen Abgabegruppe zugeordnet
+CourseUsersSubmissionGroupUnset count@Int64: #{show count} Benutzer aus ihren jeweiligen festen Abgabegruppen entfernt
+CourseUsersStateSet count@Int64: Zustand von #{show count} #{pluralDE count "Benutzer" "Benutzern"} angepasst
+
+SubmissionGroup: Feste Abgabegruppe
+NoSubmissionGroup: Keine feste Abgabegruppe
+SubmissionGroupEmptyIsUnsetTip: Leer lassen um Benutzer aus den jeweiligen Abgabegruppen ersatzlos zu entfernen
 
 ExamUserSynchronised: Synchronisiert
 ExamUserSyncOfficeName: Name
@@ -1758,6 +1833,7 @@ CsvDeleteMissing: Fehlende Einträge entfernen
 BtnCsvExport: CSV-Datei exportieren
 BtnCsvImport: CSV-Datei importieren
 BtnCsvImportConfirm: CSV-Import abschließen
+BtnCsvImportAbort: Abbrechen
 
 CsvImportNotConfigured: CSV-Import nicht vorgesehen
 CsvImportConfirmationHeading: CSV-Import Vorschau (noch keine Änderungen importiert)
@@ -1766,6 +1842,8 @@ CsvImportUnnecessary: Durch den CSV-Import würden keine Änderungen vorgenommen
 CsvImportSuccessful n@Int: CSV-Import erfolgreich, es #{pluralDE n "wurde eine Aktion" (mappend (mappend "wurden " (toMessage n)) " Aktionen")} durchgeführt
 CsvImportAborted: CSV-Import abgebrochen
 CsvImportExplanationLabel: Hinweise zum CSV-Import
+CsvExampleData: Beispiel-Datei
+CsvExportExample: Beispiel-CSV exportieren
 
 Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
 ProportionNoRatio c@Text of@Text: #{c}/#{of}
@@ -1806,6 +1884,8 @@ CsvColumnUserSemester: Fachsemester des Teilnehmers im assoziierten Studienfach
 CsvColumnUserRegistration: Zeitpunkt der Anmeldung zum Kurs (ISO 8601)
 CsvColumnUserNote: Notizen zum Teilnehmer
 CsvColumnUserTutorial: Tutorien zu denen der Teilnehmer angemeldet ist, als Semikolon (;) separierte Liste. Für Registrierungs-Gruppen unter den Tutorien gibt es jeweils eine weitere Spalte. Die Registrierungs-Gruppen-Spalten enthalten jeweils maximal ein Tutorium pro Teilnehmer. Sind alle Tutorien in Registrierungs-Gruppen, so gibt es keine Spalte "tutorial".
+CsvColumnUserExam: Prüfungen zu denen der Teilnehmer angemeldet ist, als Semikolon (;) separierte Liste.
+CsvColumnUserSubmissionGroup: Registrierte Abgabegruppe
 
 CsvColumnExamOfficeExamUserOccurrenceStart: Prüfungstermin (ISO 8601)
 
@@ -1829,6 +1909,8 @@ DBCsvDuplicateKey: Zwei Zeilen der CSV-Dateien referenzieren den selben internen
 DBCsvDuplicateKeyTip: Entfernen Sie eine der unten aufgeführten Zeilen aus Ihren CSV-Dateien und versuchen Sie es erneut.
 DBCsvKeyException: Für eine Zeile der CSV-Dateien konnte nicht festgestellt werden, ob sie zu einem bestehenden internen Datensatz korrespondieren.
 DBCsvException: Bei der Berechnung der auszuführenden Aktionen für einen Datensatz ist ein Fehler aufgetreten.
+DBCsvParseError: Eine hochgeladene Datei konnte nicht korrekt als CSV-Datei im erwarteten Format interpretiert werden.
+DBCsvParseErrorTip: Die Uni2work-Komponente, die für das Interpretieren von CSV-Dateien zuständig ist, hat folgende Fehlermeldung produziert:
 
 ExamUserCsvCourseRegister: Benutzer zum Kurs und zur Prüfung anmelden
 ExamUserCsvRegister: Kursteilnehmer zur Prüfung anmelden
@@ -1845,10 +1927,11 @@ ExamBonusNone: Keine Bonuspunkte
 
 ExamUserCsvCourseNoteDeleted: Notiz wird gelöscht
 
-ExamUserCsvExceptionNoMatchingUser: Kursteilnehmer konnte nicht eindeutig identifiziert werden
+ExamUserCsvExceptionNoMatchingUser: Benutzer konnte nicht eindeutig identifiziert werden. Alle Identifikatoren des Benutzers (Vorname(n), Nachname, Voller Name, Matrikelnummer, ...) müssen exakt übereinstimmen. Sie können versuchen für diese Zeile manche der Identifikatoren zu entfernen (also z.B. nur eine Matrikelnummer angeben) um dem System zu erlauben nur Anhand der verbleibenden Identifikatoren zu suchen. Sie sollten dann natürlich besonders kontrollieren, dass das System den fraglichen Benutzer korrekt identifiziert hat.
-ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Kursteilnehmers zugeordnet werden
+ExamUserCsvExceptionNoMatchingStudyFeatures: Das angegebene Studienfach konnte keinem Studienfach des Benutzers zugeordnet werden. Sie können versuchen für diese Zeile die Studiengangsdaten zu entfernen um das System automatisch ein Studienfach wählen zu lassen.
-ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden
+ExamUserCsvExceptionNoMatchingOccurrence: Raum/Termin konnte nicht eindeutig identifiziert werden. Überprüfen Sie, dass diese Zeile nur interne Raumbezeichnungen enthält, wie sie auch für die Prüfung konfiguriert wurden.
 ExamUserCsvExceptionMismatchedGradingMode expectedGradingMode@ExamGradingMode actualGradingMode@ExamGradingMode: Es wurde versucht eine Prüfungsleistung einzutragen, die zwar vom System interpretiert werden konnte, aber nicht dem für diese Prüfung erwarteten Modus entspricht. Der erwartete Bewertungsmodus kann unter "Prüfung bearbeiten" angepasst werden ("Bestanden/Nicht Bestanden", "Numerische Noten" oder "Gemischt").
+ExamUserCsvExceptionNoOccurrenceTime: Es wurde versucht eine Prüfungsleistung ohne einen zugehörigen Zeitpunkt einzutragen. Sie können entweder einen Zeitpunkt pro Student in der entsprechenden Spalte hinterlegen, oder einen voreingestellten Zeitpunkt unter "Bearbeiten" angeben.
 
 ExternalExamUserCsvRegister: Prüfungsleistung hinterlegen
 ExternalExamUserCsvSetTime: Zeitpunkt anpassen
@@ -2179,8 +2262,13 @@ CourseNewsDeleteQuestion: Wollen Sie die unten aufgeführte Nachricht wirklich l
 CourseNewsDeleted: Kursnachricht erfolgreich gelöscht
 
 CourseDeregistrationAllocationLog: Ihr Platz in diesem Kurs stammt aus einer Zentralanmeldung. Wenn Sie sich vom Kurs abmelden wird dieser Umstand permanent im System gespeichert und kann Sie u.U. bei zukünftigen Zentralanmeldungen benachteiligen. Wenn Sie gute Gründe vorzuweisen haben, warum Ihre Abmeldung nicht selbstverschuldet ist, kontaktieren Sie bitte einen Kursverwalter. Diese haben die Möglichkeit Sie ohne permanente Eintragung im System abzumelden. 
+CourseDeregistrationNoShow: Wenn Sie sich vom Kurs abmelden, wird für alle Prüfungen des Kurses „nicht erschienen“ gemeldet. Wenn Sie gute Gründe vorzuweisen haben, warum Ihre Abmeldung nicht selbstverschuldet ist, kontaktieren Sie bitte einen Kursverwalter. Diese haben die Möglichkeit Sie ohne permanente Eintragung im System abzumelden. 
 CourseDeregistrationAllocationReason: Grund
 CourseDeregistrationAllocationReasonTip: Der angegebene Grund wird permanent im System hinterlegt und ist i.A. einziger Anhaltspunkt zur Schlichtung etwaiger Konflikte
+CourseDeregistrationAllocationNoShow: „Nicht erschienen“ eintragen
+CourseDeregistrationAllocationNoShowTip: Soll für alle Prüfungen dieses Kurses „nicht erschienen“ als Prüfungsleistung eingetragen werden? Dies geschieht einmalig bei der Abmeldung (sofern nicht bereits eine Prüfungsleistung existiert) und automatisch beim Anlegen von neuen Prüfungen.
+CourseDeregisterNoShow: „Nicht erschienen“ bei Abmeldung
+CourseDeregisterNoShowTip: Soll, wenn sich Teilnehmer selbstständig abmelden, für alle Prüfungen dieses Kurses „nicht erschienen“ als Prüfungsleistung eingetragen werden? Dies geschieht einmalig bei der Abmeldung (sofern nicht bereits eine Prüfungsleistung existiert) und automatisch beim Anlegen von neuen Prüfungen.
 CourseDeregistrationAllocationShouldLog: Selbstverschuldet
 CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
 
@@ -2202,11 +2290,14 @@ FavouriteParticipant: Ihre Kurse
 FavouriteManual: Favoriten
 FavouriteCurrent: Aktueller Kurs
 
+FavouritesUnavailableTip: Das Schnellzugriffsmenü für diesen Kurs ist aktuell nicht verfügbar.
+
 CourseEvents: Termine
 CourseEventType: Art
 CourseEventTypePlaceholder: Vorlesung, Zentralübung, ...
 CourseEventTime: Zeit
 CourseEventRoom: Regulärer Raum
+CourseEventNote: Notiz
 CourseEventActions: Aktionen
 CourseEventsActionEdit: Bearbeiten
 CourseEventsActionDelete: Löschen
@@ -2379,3 +2470,70 @@ AllocationPrioritiesFile: CSV-Datei
 AllocationPrioritiesSunk num@Int64: Zentrale Prioritäten für #{num} Bewerber erfolgreich hinterlegt
 AllocationPrioritiesMissing num@Int64: Für #{num} Bewerber ist keine zentrale Priorität hinterlegt, da in der hochgeladenen CSV-Datei die #{pluralDE num "entsprechende Matrikelnummer" "entsprechenden Matrikelnummern"} nicht gefunden #{pluralDE num "wurde" "wurden"}
 AllocationMissingPrioritiesIgnored: Bewerber, für die keine zentrale Priorität angegeben wird, werden bei der Vergabe ignoriert!
+
+ExampleUser1FirstName: Max ZweiterName
+ExampleUser1Surname: Mustermann
+ExampleUser1DisplayName: Max Mustermann
+ExampleUser2FirstName: Martha
+ExampleUser2Surname: Musterstudent
+ExampleUser2DisplayName: Musterstudent Martha
+ExampleUser3FirstName: Maria
+ExampleUser3Surname: Beispiel
+ExampleUser3DisplayName: Beispiel
+
+AllocationUsersMissingPriorities: Teilnehmer ohne zentrale Dringlichkeit
+AllocationUsersMissingPrioritiesTip: Es muss sichergestellt sein, dass keine Teilnehmer unberechtigt aus der Zentralvergabe ausgeschlossen werden, indem ihnen keine zentrale Dringlichkeit zugewiesen wurde.
+AllocationUsersMissingPrioritiesOk: Es wurde sichergestellt, dass es für jeden der genannten Benutzer einen zulässigen Grund gibt, warum dieser nicht an der Zentralanmeldung teilnehmen sollte.
+AllocationRestrictCourses: Kurse einschränken
+AllocationRestrictCoursesTip: Sollen nur Plätze für eine Teilmenge von Kursen zugewiesen werden? So können u.A. Nachrücker verteilt werden. Diese Funktionalität sollte nur verwendet werden, wenn manche Kurse aus zulässigen Gründen ausgeschlossen werden müssen; z.B. weil ein Seminar bereits ein Treffen zur Organisation hatte und nun keine weiteren Teilnehmer mehr akzeptieren kann.
+AllocationRestrictCoursesSelection: Kurse
+AllocationRestrictCoursesSelectionTip: Teilnehmer werden nur auf die Kurse verteilt, die hier angegeben werden.
+AllocationUsersMissingPrioritiesNotOk: Zentralvergabe kann nicht erfolgen, solange nicht allen Teilnehmern, die nicht explizit von der Vergabe ausgeschlossen wurden („Teilnehmer ohne zentrale Dringlichkeit”), eine zentrale Dringlichkeit zugewiesen wurde! 
+AllocationComputed: Eine mögliche Zentralvergabe wurde berechnet und in Ihrer Session gespeichert. Es wurden noch keine Änderungen vorgenommen!
+AllocationOnlyCompute: Durch Senden dieses Formulars wird zunächst nur eine mögliche Zentralvergabe berechnet und zur Kontrolle temporär gespeichert. Es werden keine Änderungen am Stand der Datenbank vorgenommen oder Benachrichtigungen verschickt.
+AllocationAcceptFormDoesNotMatchSession: Das Formular zum Akzeptieren der Vergabe wurde für ein anderes Vergabeergebnis erzeugt, als aktuell in Ihrer Session gespeichert ist.
+ComputedAllocation: Berechnete Vergabe
+AllocationAccepted: Zentralvergabe gespeichert.
+AllocationMatchedUsers: Neu zugeteilt
+AllocationUnmatchedUsers: Teilnehmer ohne zugeteilte Plätze
+AllocationUnmatchedCourses: Kurse ohne zugeteilte Teilnehmer
+AllocationTime: Zeitpunkt der Vergabe
+AllocationRequestedPlaces: Angefragte Plätze
+AllocationOfferedPlaces: Angebotene Plätze
+AllocationUserNewMatches: Neue Zuteilungen
+AllocationUsersCount: Teilnehmer
+AllocationCoursesCount: Kurse
+
+CourseOption tid@TermId ssh@SchoolId coursen@CourseName: #{tid} - #{ssh} - #{coursen}
+
+BearerTokenUsageWarning: Mit diesem Interface können quesi beliebige Rechte als Tokens kodiert und somit ohne wesentliche weitere Beschränkung frei übertragen werden. Benutzen Sie dieses Interface nur, wenn Sie von einem erfahrenen Entwickler über die Auswirkungen des konkreten Tokens, dass sie ausstellen möchten, beraten wurden!
+BearerTokenAuthorityGroups: Token-Authorität (Gruppen)
+BearerTokenAuthorityGroupsTip: Die primären Benutzer aller angegebenen Gruppen müssen Zugriff auf eine Route haben, damit das Token den Zugriff auf diese Route erlaubt.
+BearerTokenAuthorityUsers: Token-Authorität (Benutzer)
+BearerTokenAuthorityUsersTip: Alle angegebenen Benutzer müssen Zugriff auf eine Route haben, damit das Token den Zugriff auf diese Route erlaubt. Der Aussteller muss, bei mit diesem Benutzerinterface erzeugten Tokens, auch Zugriff auf die Route haben (er wird automatisch der Menge von Token-Authoritäten hinzugefügt).
+BearerTokenAuthorityUnknownUser email@UserEmail: Ein Nutzer mit E-Mail #{email} ist dem System nicht bekannt
+BearerTokenRoutes: Erlaubte Routen
+BearerTokenRoutesTip: Wenn die Token-Validität nach Routen eingeschränkt und keine Routen angegeben werden, ist das Token nirgends gültig.
+BearerTokenRestrictions: Routen-spezifische Einschränkungen
+BearerTokenRestrictRoutes: Token-Validität nach Routen einschränken
+BearerTokenAdditionalAuth: Zusätzliche Authorisierung
+BearerTokenAdditionalAuthTip: Wird hier nichts angegeben, werden keine Einschränkungen daran gesetzt, wer das Token verwenden kann. Es reicht dann der Besitz.
+BearerTokenOverrideExpiration: Ablaufzeitpunkt überschreiben
+BearerTokenExpires: Ablaufzeitpunkt
+BearerTokenExpiresTip: Wird der Ablaufzeitpunkt überschrieben und kein Ablaufzeitpunkt angegeben, ist das Token für immer gültig.
+BearerTokenOverrideStart: Startzeitpunkt
+BearerTokenOverrideStartTip: Wird kein Startzeitpunkt angegeben, wird bei Verwendung des Tokens nur der Ablaufzeitpunkt überprüft.
+
+FaqTitle: Häufig gestellte Fragen
+AdditionalFaqs: Weitere häufig gestellte Fragen
+
+MultiActionUnknownAction: In einem von einem Eingabefeld abhängigen Formular wurde ein Wert gewählt, für den kein Formular verfügbar ist
+
+CourseParticipantStateIsActive: Aktive Teilnehmer
+CourseParticipantStateIsInactive: Ehemalige Teilnehmer
+CourseParticipantStateIsActiveFilter: Ansicht
+CourseUserReRegister: Wieder anmelden
+CourseParticipantActive: Teilnehmer
+CourseParticipantInactive: Abgemeldet
+CourseParticipantNoShow: Nicht erschienen
+CourseUserState: Zustand

messages/uniworx/en-eu.msg

@@ -32,6 +32,10 @@ BtnLecInvDecline: Decline
 BtnCorrInvAccept: Accept
 BtnCorrInvDecline: Decline
 BtnSubmissionsAssign: Assign submissions automatically
+BtnAllocationCompute: Compute allocation
+BtnAllocationAccept: Accept allocation
+BtnSystemMessageHide: Hide
+BtnSystemMessageUnhide: Unhide
 
 
 Aborted: Aborted
@@ -116,11 +120,12 @@ CourseStudyFeatureTip: For information purposes only (visible to course administ
 CourseStudyFeatureUpdated: Successfully updated associated subject
 CourseStudyFeatureNone: No associated subject
 CourseTutorial: Tutorial
+CourseExam: Exam
 CourseSecretWrong: Wrong password
 CourseSecret: Access password
 CourseEditOk tid ssh csh: Successfully edited course #{tid}-#{ssh}-#{csh} 
-CourseNewDupShort tid ssh csh: Could not create course #{tid}-#{ssh}-#{csh}. Another course with shorthand #{csh} already exists for the given semester and school.
+CourseNewDupShort tid ssh csh: Could not create course #{tid}-#{ssh}-#{csh}. Another course with the same shorthand or title already exists for the given semester and school.
-CourseEditDupShort tid ssh csh: Could not edit course #{tid}-#{ssh}-#{csh}. Another course with shorthand #{csh} already exists for the given semester and school.
+CourseEditDupShort tid ssh csh: Could not edit course #{tid}-#{ssh}-#{csh}. Another course with the same shorthand or title already exists for the given semester and school.
 FFSheetName: Name
 TermCourseListHeading tid: Courses #{tid}
 TermSchoolCourseListHeading tid school: Courses #{tid}, #{school}
@@ -158,7 +163,13 @@ BoolIrrelevant: —
 CourseDeleteQuestion: Are you sure you want to delete the below-mentioned course?
 CourseDeleted: Course deleted
 CourseUserRegister: Enrol for course
+CourseUserTutorial: Registered tutorial
 CourseUserTutorials: Registered tutorials
+CourseUserExam: Registered exam
+CourseUserExams: Registered exams
+CourseSingleUserExams: Exams
+CourseSingleUserTutorials: Tutorials
+CourseUserCorrections: Submissions
 CourseUserNote: Note
 CourseUserNoteTooltip: Only visible to administrators of this course
 CourseUserNoteSaved: Successfully saved note changes
@@ -167,6 +178,8 @@ CourseUserDeregister: Deregister from course
 CourseUsersDeregistered count: Successfully deregistered #{show count} users from course
 CourseUserRegisterTutorial: Register for a tutorial
 CourseUsersTutorialRegistered count: Successfully registered #{show count} users for tutorial
+CourseUserRegisterExam: Register for an exam
+CourseUsersExamRegistered count: Successfully registered #{show count} users for exam
 CourseUserSendMail: Send mail
 TutorialUserDeregister: Deregister from tutorial
 TutorialUserSendMail: Send mail
@@ -310,6 +323,8 @@ SheetSolutionFromTip: Always invisible for participants if left empty; corrector
 SheetMarkingTip: Instructions for correction, visible only to correctors
 SheetPseudonym: Personal pseudonym
 SheetGeneratePseudonym: Generate
+SheetAnonymousCorrection: Anonymized correction
+SheetAnonymousCorrectionTip: If correction is anonymized, correctors cannot see which students are involved in submissions that are assigned to them (names, matriculation numbers, and registered submission groups are hidden)
 
 SheetFormType: Valuation & submission
 SheetFormTimes: Times
@@ -319,6 +334,8 @@ SheetErrVisibility: "Submission period start" must be after "Visible from"
 SheetErrDeadlineEarly: "Submission period end" must be after "Submission period start"
 SheetErrHintEarly: "Hint from" must be after "Submission period start"
 SheetErrSolutionEarly: "Solution from" must be after "Submission period end"
+SheetErrVisibleWithoutActive: If “Visible from (for participants)” is specified “Active from/Submission period start” must also be specified
+SheetWarnNoActiveTo: “Active to/Submission period end” should always be specified
 SheetNoCurrent: There is no currently active exercise sheet
 SheetNoOldUnassigned: All submissions for inactive sheets are already assigned to correctors.
 SheetsUnassignable name: Submission for #{name} may not currently be assigned to correctors.
@@ -393,6 +410,7 @@ UnauthorizedTokenExpired: Your authorisation-token is expired.
 UnauthorizedTokenNotStarted: Your authorisation-token is not yet valid.
 UnauthorizedTokenInvalid: Your authorisation-token could not be processed.
 UnauthorizedTokenInvalidRoute: Your authorisation-token is not valid for this page.
+UnauthorizedTokenInvalidNoAuthority: Your authorisation-token does not list any users on whose rights it is based.
 UnauthorizedTokenInvalidAuthority: Your authorisation-token is based in an user's rights who does not exist anymore.
 UnauthorizedTokenInvalidAuthorityGroup: Your authorisation-token is based in an user groups rights which does not exist anymore.
 UnauthorizedTokenInvalidAuthorityValue: The specification of the rights in which your authorisation-token is based, could not be interpreted.
@@ -402,6 +420,7 @@ UnauthorizedSchoolAdmin: You are no administrator for this department.
 UnauthorizedAdminEscalation: You aren't an administrator for all departments for which this user is an administrator.
 UnauthorizedExamOffice: You are not part of an exam office.
 UnauthorizedEvaluation: You are not charged with course evaluation.
+UnauthorizedAllocationAdmin: You are not charged with the administration of central allocations.
 UnauthorizedExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
 UnauthorizedExternalExamExamOffice: You are not part of the appropriate exam office for any of the participants of this exam.
 UnauthorizedSchoolLecturer: You are no lecturer for this department.
@@ -455,6 +474,8 @@ UnauthorizedLDAP: Specified user does not log in with their campus account.
 UnauthorizedPWHash: Specified user does not log in with an Uni2work-account.
 UnauthorizedExternalExamListNotEmpty: List of external exams is not empty
 UnauthorizedExternalExamLecturer: You are not an associated person for this external exam
+UnauthorizedSubmissionSubmissionGroup: You are not member in any of the submission groups for this submission
+UnauthorizedSheetSubmissionGroup: You are not member in any submission group
 
 UnauthorizedPasswordResetToken: This authorisation-token may no longer be used to change passwords
 
@@ -511,11 +532,17 @@ NewsOpenAllocations: Active central allocations
 NewsUpcomingSheets: Upcoming exercise sheets
 NewsUpcomingExams: Upcoming exams
 
+NewsHideHiddenSystemMessages: Don't show hidden news items
+NewsShowHiddenSystemMessages: Show hidden news items
+
 NumCourses num: #{num} #{pluralEN num "course" "courses"}
 CloseAlert: Close
 
 Name: Name
 MatrikelNr: Matriculation
+Surname: Surname(s)
+FirstName: Given name(s)
+Title: Title
 LdapSynced: LDAP-synchronised
 LdapSyncedBefore: Last LDAP-synchronisation before
 NoMatrikelKnown: No matriculation
@@ -542,6 +569,12 @@ DBTablePagesize: Entries per page
 DBTablePagesizeAll: All
 
 CorrDownload: Download
+CorrDownloadAnonymous: Anonymized
+CorrDownloadAnonymousTip: If submissions are downloaded non-anonymized the selected feature of the submittors are appended to the name of the dirctory for each submission where permitted
+SubmissionDownloadAnonymous: Anonymized
+SubmissionDownloadSurnames: With surnames
+SubmissionDownloadMatriculations: With matriculation numbers
+SubmissionDownloadGroups: With registered submission groups
 CorrUploadField: Corrections
 CorrUpload: Upload corrections
 CorrSetCorrector: Assign corrector
@@ -752,6 +785,9 @@ UploadModeExtensionRestriction: Allowed file extensions
 UploadModeExtensionRestrictionTip: Comma-separated. If no file extensions are specified, uploads are not restricted.
 UploadModeExtensionRestrictionEmpty: List of permitted file extensions may not be emptyy
 
+GenericFileFieldInvalidExtension file: “#{file}” does not have an acceptable file extension
+FileUploadOnlySessionTip: You have uploaded this file during your current session. It has not yet been saved permanently. The file will be saved permanently if you “Send” as part of this Form.
+
 UploadSpecificFiles: Pre-defined files
 NoUploadSpecificFilesConfigured: If pre-defined files are selected, at least one file needs to be configured.
 UploadSpecificFilesDuplicateNames: Names of pre-defined files must be unique
@@ -765,6 +801,8 @@ CorrectorSubmissions: External submission via pseudonym
 UserSubmissions: Direct submission in Uni2work
 BothSubmissions: Submission either directly in Uni2work or externally via pseudonym
 
+BothSubmissionsTip: Participants may choose to submit either directly in Uni2work or externally via a pseudonym
+
 SheetCorrectorSubmissionsTip: Submissions are expected to be handed in through some Uni2work-external procedure (usually on paper) marked with your personal pseudonym. Correctors can, using the pseudonym, register the marking in Uni2work for you to review.
 
 SubmissionNoUploadExpected: No upload of files expected.
@@ -948,6 +986,7 @@ SheetTypeBonus grading: Bonus
 SheetTypeNormal grading: Normal
 SheetTypeInformational grading: Informational
 SheetTypeNotGraded: Not marked
+SheetTypeInfoNormalLecturer: Normal sheets are used to calculate exam bonuses. Bonuses may be calculated from the number of sheets that can be passed or the maximum number of points achievable either manually or automatically.
 SheetTypeInfoNotGraded: "Not marked" means that there will be no feedback at all.
 SheetTypeInfoBonus: Sheets marked "bonus" count normally but do not increase either the maximum number of points or the count of sheets that can be passed.
 SheetTypeInfoInformational: Sheets marked "informational" do not counted anywhere. They are marked only as feedback for participants.
@@ -1013,6 +1052,7 @@ NotificationTriggerKindEvaluation: For course evaluations
 NotificationTriggerKindAllocationStaff: For central allocations (lecturers)
 NotificationTriggerKindAllocationParticipant: For central allocations
 NotificationTriggerKindSubmissionUser: For participants in an exercise sheet submission
+NotificationTriggerKindAllocationAdmin: For administrators of central allocations
 
 CorrCreate: Register submissions
 UnknownPseudonymWord pseudonymWord: Invalid pseudonym-word “#{pseudonymWord}”
@@ -1049,9 +1089,22 @@ HelpRequest: Support request / Suggestion
 HelpProblemPage: Problematic page
 HelpIntroduction: If you have trouble using this website or if you find something that could be improved, please contact us even if you were already able to solve your problem by yourself! We are continually making changes and try to keep the site as intuitive as possible even for new users.
 HelpSent: Your support request has been sent.
+HelpSendLastError: Attach last error message
+HelpError: Last error message
+HelpErrorYamlFilename mailId: error-#{toPathPiece mailId}.yaml
+HelpErrorOrRequestRequired: Please attach either the last error message or submit a support request or a suggestion
 
 InfoLecturerTitle: Information for lecturers
 
+SystemMessageNewsOnly: Only on "News"
+SystemMessageRecordChanged: Signifcant change
+SystemMessageRecordChangedTip: Should the "last changed"-timestamp be adjusted? News are sorted by "last changed" on "News". After a significant change news items are displayed once again as a popup in the bottom right.
+SystemMessageUnhide: Ignore previously hidden
+SystemMessageUnhideTip: Should the news item be display again for users that have actively hidden it?
+SystemMessageCreated: Created
+SystemMessageLastChanged: Last changed
+SystemMessageLastChangedAt time: Last changed: #{time}
+SystemMessageLastUnhide: Last unhidden
 SystemMessageFrom: Visible from
 SystemMessageTo: Visible to
 SystemMessageAuthenticatedOnly: Only logged in users
@@ -1144,6 +1197,7 @@ MenuUserPassword: Password
 MenuAdminTest: Admin-demo
 MenuMessageList: System messages
 MenuAdminErrMsg: Decrypt error message
+MenuAdminTokens: Issue tokens
 MenuProfileData: Personal information
 MenuTermCreate: Create new semester 
 MenuCourseNew: Create new course
@@ -1209,6 +1263,11 @@ MenuExternalExamNew: New external exam
 MenuExternalExamList: External exams
 MenuParticipantsList: Lists of course participants
 MenuParticipantsIntersect: Common course participants
+MenuAllocationUsers: Applicants
+MenuAllocationPriorities: Central priorities
+MenuAllocationCompute: Compute allocation
+MenuAllocationAccept: Accept allocation
+MenuFaq: FAQ
 
 BreadcrumbSubmissionFile: File
 BreadcrumbSubmissionUserInvite: Invitation to participate in a submission
@@ -1274,6 +1333,12 @@ BreadcrumbParticipantsList: Lists of course participants
 BreadcrumbParticipants: Course participants
 BreadcrumbExamAutoOccurrence: Automatic occurrence/room distribution
 BreadcrumbStorageKey: Generate storage key
+BreadcrumbAllocationUsers: Applicants
+BreadcrumbAllocationPriorities: Central priorities
+BreadcrumbAllocationCompute: Compute allocation
+BreadcrumbAllocationAccept: Accept allocation
+BreadcrumbMessageHide: Hide
+BreadcrumbFaq: FAQ
 
 ExternalExamEdit coursen examn: Edit: #{coursen}, #{examn}
 ExternalExamGrades coursen examn: Exam achievements: #{coursen}, #{examn}
@@ -1288,6 +1353,7 @@ AuthTagFree: Page is freely accessable
 AuthTagAdmin: User is administrator
 AuthTagExamOffice: User is part of an exam office
 AuthTagEvaluation: User is charged with course evaluation
+AuthTagAllocationAdmin: User is charged with administration of central allocations
 AuthTagToken: User is presenting an authorisation-token
 AuthTagNoEscalation: User permissions are not being expanded to other departments
 AuthTagDeprecated: Page is not deprecated
@@ -1323,6 +1389,7 @@ AuthTagIsPWHash: User logs in using their Uni2work-internal account
 AuthTagAuthentication: User is authenticated
 AuthTagRead: Access is read only
 AuthTagWrite: Access might write
+AuthTagSubmissionGroup: User is part of a submission group
 
 DeleteCopyStringIfSure n: If you are sure that you want to permanently delete the #{pluralEN n "object" "objects"} listed below, please copy the shown text.
 DeletePressButtonIfSure n: If you are sure that you want to permanently delete the #{pluralEN n "object" "objects"} listed below, please confirm the action by pressing the button.
@@ -1673,6 +1740,7 @@ ExamRegistered: Registered for the exam
 ExamNotRegistered: Not registered for the exam
 ExamRegistration: Exam registration
 ExamLoginToRegister: Your need to login to Uni2work before you can register for this course.
+ExamRegistrationTime: Registered since
 
 ExamRegisterToMustBeAfterRegisterFrom: "Register to" must be after "register from"
 ExamDeregisterUntilMustBeAfterRegisterFrom: "Deregister until" must be after "register from"
@@ -1712,6 +1780,20 @@ ExamUsersResultsReset count: Successfully reset result for #{show count} #{plura
 ExamUsersPartResultsSet count: Successfully modified exam part result for #{show count} #{pluralEN count "participant" "participants"}
 ExamUsersBonusSet count: Successfully modified exam bonus for #{show count} #{pluralEN count "participant" "participants"}
 ExamUsersResultSet count: Sucessfully modified exam result for #{show count} #{pluralEN count "participant" "participants"}
+CourseUserTutorialsDeregistered count: Sucessfully deregistered participant from #{show count} #{pluralEN count "tutorial" "tutorials"}
+CourseUserNoTutorialsDeregistered: Participant is not registered for any of the selected tutorials
+CourseUserExamsDeregistered count: Successfully deregistered participant from #{show count} #{pluralEN count "exam" "exams"}
+CourseUserNoExamsDeregistered: Participant is not registered for any of the selected exams
+CourseUserExamsResultSet count: Successfully adjusted the participant's result for #{show count} #{pluralEN count "exam" "exams"}
+CourseUserExamResultDoesNotMatchMode examn: The chosen result does not match the grading mode for exam “#{examn}”
+CourseUserSetSubmissionGroup: Set/Unset registered submission group
+CourseUsersSubmissionGroupSetNew count: Successfully added #{show count} #{pluralEN count "user" "users"} to submission group
+CourseUsersSubmissionGroupUnset count: Successfully removed #{show count} #{pluralEN count "user" "users"} from their #{pluralEN count "submission group" "respective submission groups"}
+CourseUsersStateSet count: Successfully changed state of #{show count} #{pluralEN count "user" "users"}
+
+SubmissionGroup: Registered submission group
+NoSubmissionGroup: No registered submission group
+SubmissionGroupEmptyIsUnsetTip: Leave empty to remove users from their respective submission groups
 
 ExamUserSynchronised: Synchronised
 ExamUserSyncOfficeName: Name
@@ -1750,6 +1832,7 @@ CsvDeleteMissing: Delete missing entries
 BtnCsvExport: Export CSV file
 BtnCsvImport: Import CSV file
 BtnCsvImportConfirm: Finalise CSV import
+BtnCsvImportAbort: Abort
 
 CsvImportNotConfigured: CSV import not configured
 CsvImportConfirmationHeading: CSV import preview (no changes have been made yet)
@@ -1758,6 +1841,8 @@ CsvImportUnnecessary: Importing the given CSV file does not correspond to perfor
 CsvImportSuccessful n: Successfully imported CSV file. #{n} #{pluralEN n "edit" "edits"} have been performed.
 CsvImportAborted: CSV import aborted
 CsvImportExplanationLabel: Informating regarding CSV import
+CsvExampleData: Example data
+CsvExportExample: Export example CSV
 
 Proportion c of prop: #{c}/#{of} (#{rationalToFixed2 (100 * prop)}%)
 ProportionNoRatio c of: #{c}/#{of}
@@ -1798,6 +1883,8 @@ CsvColumnUserSemester: Semester the participant is in wrt. to their associated f
 CsvColumnUserRegistration: Time of participant's enrollment (ISO 8601)
 CsvColumnUserNote: Course notes for the participant
 CsvColumnUserTutorial: Tutorials which the user is registered for, separated by semicolon (;). For each registration group among the tutorials there is a separate column. The registration group columns contain at most one tutorial per participant. If every tutorial has a registration group there is no column "tutorial".
+CsvColumnUserExam: Exams which the user is registered for, separated by semicolon (;).
+CsvColumnUserSubmissionGroup: Registered submission group
 
 CsvColumnExamOfficeExamUserOccurrenceStart: Exam occurrence (ISO 8601)
 
@@ -1821,6 +1908,8 @@ DBCsvDuplicateKey: Two rows in the CSV file reference the same database entry an
 DBCsvDuplicateKeyTip: Please remove one of the lines listed below and try again.
 DBCsvKeyException: For a row in the CSV file it could not be determined whether it references any database entry.
 DBCsvException: An error occurred hile computing the set of edits this CSV import corresponds to.
+DBCsvParseError: An uploaded file could not be interpreted as CSV of the expected format.
+DBCsvParseErrorTip: The Uni2work-component that handles CSV decoding has reported the following error:
 
 ExamUserCsvCourseRegister: Register users for the exam and enroll them in the course
 ExamUserCsvRegister: Register users for the exam
@@ -1837,10 +1926,11 @@ ExamBonusNone: No bonus points
 
 ExamUserCsvCourseNoteDeleted: Course note will be deleted
 
-ExamUserCsvExceptionNoMatchingUser: Course participant could not be identified uniquely
+ExamUserCsvExceptionNoMatchingUser: Course participant could not be identified uniquely. All identifiers (given name(s), surname, display name, matriculation, ..) must match exactly. You can try to remove some of the identifiers for the given line (i.e. all but matriculation). Uni2work will then search for users using only the remaining identifiers. In this case special care should be taken that Uni2work correctly identifies the intended user.
-ExamUserCsvExceptionNoMatchingStudyFeatures: The specified field did not match with any of the participant's fields of study
+ExamUserCsvExceptionNoMatchingStudyFeatures: The specified field did not match with any of the participant's fields of study. You can try to remove the field of study for the given line. Uni2work will then automatically choose a field of study.
-ExamUserCsvExceptionNoMatchingOccurrence: Occurrence/room could not be identified uniquely
+ExamUserCsvExceptionNoMatchingOccurrence: Occurrence/room could not be identified uniquely. Please ensure that the given line only contains internal room identifiers exactly as they have been configured for this exam.
 ExamUserCsvExceptionMismatchedGradingMode expectedGradingMode actualGradingMode: The imported data contained an exam achievement which does not match the grading mode for this exam. The expected grading mode can be changed at "Edit exam" ("Passed/Failed", "Numeric grades", or "Mixed").
+ExamUserCsvExceptionNoOccurrenceTime: The imported data contained an exam achievement without an associated time. You can either enter a time for each student in the appropriate column or you can set a default time for the entire exam under "Edit".
 
 ExternalExamUserCsvRegister: Store exam achievement
 ExternalExamUserCsvSetTime: Adjust exam time
@@ -2011,6 +2101,7 @@ SchoolAdmin: Admin
 SchoolLecturer: Lecturer
 SchoolEvaluation: Course evaluation
 SchoolExamOffice: Exam office
+SchoolAllocation: Administration of central allocations
 
 ApplicationEditTip: During the application period you may edit and retract your applications at will.
 
@@ -2171,8 +2262,13 @@ CourseNewsDeleteQuestion: Are you sure you want to delete the item of course new
 CourseNewsDeleted: Successfully deleted item of course news
 
 CourseDeregistrationAllocationLog: Your enrollment in this course is due to a central allocation. If you leave the course, this will be permanently recorded and might affect you negatively in future central allocations. If you have good reasons why you should not be held accountable for leaving the course, please contact a course administrator. Course administrators can deregister you without incurring a permanent record.
+CourseDeregistrationNoShow: If you deregister from this course “no show” will be recorded as your exam achievement for all exams associated with this course. If you have good reasons why you shold not be held accountable for leaving the course, please contact a course administrator. Course administrators can deregister you without incurring a permanent record.
 CourseDeregistrationAllocationReason: Reason
 CourseDeregistrationAllocationReasonTip: The specified reason will be permanently stored and might be the only information available during conflict resolution
+CourseDeregistrationAllocationNoShow: Record as “no show”
+CourseDeregistrationAllocationNoShowTip: Should, for all exams associated with this course, “no show” be recorded as the exam achievement automatically? This would be done once immediately (if no other achievement exists for the given exam) and automatically whenever a new exam is created.
+CourseDeregisterNoShow: Record “no show” when deregistering
+CourseDeregisterNoShowTip: Should “no show” be recorded as the exam achievement for all exams associated with this course automatically whenever a course participant deregisters themselves? This would be done once upon deregistration (if no other achievement exists for the given exam) and automatically whenever a new exam is created.
 CourseDeregistrationAllocationShouldLog: Self imposed
 CourseDeregistrationAllocationShouldLogTip: If the participant was enrolled in this course due to a central allocation, it is intended that a permanent record be made that might affect the student negatively in future central allocations. As a course administrator you have the right to prevent this if the participant can present good reasons why them leaving the course is not self imposed.
 
@@ -2194,11 +2290,14 @@ FavouriteParticipant: Your courses
 FavouriteManual: Favourites
 FavouriteCurrent: Current course
 
+FavouritesUnavailableTip: Quick Actions for this course are currently not available.
+
 CourseEvents: Occurrences
 CourseEventType: Type
 CourseEventTypePlaceholder: Lecture, Exercise discussion, ...
 CourseEventTime: Time
 CourseEventRoom: Regular room
+CourseEventNote: Note
 CourseEventActions: Actions
 CourseEventsActionEdit: Edit
 CourseEventsActionDelete: Delete
@@ -2344,3 +2443,97 @@ InfoLecturerAllocations: Central allocations
 
 ParticipantsIntersectCourseOption tid@TermId ssh@SchoolId coursen@CourseName: #{tid} - #{ssh} - #{coursen}
 ParticipantsIntersectCourses: Courses
+
+AllocationUsersTitle tid ssh ash: #{tid}-#{ssh}-#{ash}: Applicants
+AllocationUsersApplied: Applications
+AllocationUsersAssigned: Assignments
+AllocationUsersVetoed: Vetos
+AllocationUsersRequested: Requested assignments
+AllocationUsersPriority: Central priority
+
+CsvColumnAllocationUserSurname: Applicant's surname(s)
+CsvColumnAllocationUserFirstName: Applicants's first name(s)
+CsvColumnAllocationUserName: Applicant's full name
+CsvColumnAllocationUserMatriculation: Applicant's matriculation
+CsvColumnAllocationUserRequested: Maximum number of placements the applicant is prepared to accept
+CsvColumnAllocationUserApplied: Number of applications the applicant has provided
+CsvColumnAllocationUserVetos: Number of applications that have received a veto from a course administrator or have been rated with a grade that is equivalent to "failed" (5.0)
+CsvColumnAllocationUserAssigned: Number of assignments the applicant has already received
+CsvColumnAllocationUserPriority: Central priority of this applicant; either a number based on the applicants position in the list sorted by priority (higher numbers mean a higher priority) or a comma-separated list of numerical priorities in square brackets (e.g. [1, 2, 3])
+AllocationUsersCsvName tid ssh ash: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash}-applicants
+
+AllocationPrioritiesMode: Mode
+AllocationPrioritiesNumeric: Numeric priorities
+AllocationPrioritiesOrdinal: Priorities based on sorted list
+AllocationPrioritiesTitle tid ssh ash: #{tid}-#{ssh}-#{ash}: Central priorities
+AllocationPrioritiesFile: CSV file
+AllocationPrioritiesSunk num: Successfully registered central priorities for #{num} #{pluralEN num "applicant" "applicants"}
+AllocationPrioritiesMissing num: Could not register central priorities for #{num} #{pluralEN num "applicant" "applicants"} because their matriculation was not found in the uploaded CSV file
+AllocationMissingPrioritiesIgnored: Applicants for whom no central priority has been registered will be ignored during assignment!
+
+ExampleUser1FirstName: Max SecondName
+ExampleUser1Surname: Mustermann
+ExampleUser1DisplayName: Max Mustermann
+ExampleUser2FirstName: Martha
+ExampleUser2Surname: Musterstudent
+ExampleUser2DisplayName: Musterstudent Martha
+ExampleUser3FirstName: Maria
+ExampleUser3Surname: Example
+ExampleUser3DisplayName: Example
+
+AllocationUsersMissingPriorities: Participants without central priority
+AllocationUsersMissingPrioritiesTip: Care must be taken, that no participant is excluded from the allocation by not having been assigned a central priority.
+AllocationUsersMissingPrioritiesOk: It was ensured, that all participants mentioned above, are excluded from the allocation on valid grounds.
+AllocationRestrictCourses: Restrict courses
+AllocationRestrictCoursesTip: Should places be assigned only in a subset of courses? This functionality can be used to make alternate placements in the case that some participants withdraw from their assigned courses. This functionality should only be used to exclude courses on valid grounds. E.g. if a seminar already had a planning meeting and is thus unable to accept new participants.
+AllocationRestrictCoursesSelection: Courses
+AllocationRestrictCoursesSelectionTip: Participants will only be assigned to courses listed here.
+AllocationUsersMissingPrioritiesNotOk: Central allocation cannot occur until all participants, that were not excluded explicitly (“Participants without central priority”), have been assigned a central priority!
+AllocationComputed: A possible allocation has been computed and stored in your session. No changes have yet been made!
+AllocationOnlyCompute: By sending this form a possible allocation will be computed and saved temporarily. You can then check that the computed allocation is as expected. No changes will yet be made to the state of the database and no notifications will be sent.
+AllocationAcceptFormDoesNotMatchSession: The form to accept the computed allocation was generated for a different result than the one, that is currently saved in your session.
+ComputedAllocation: Computed allocation
+AllocationAccepted: Successfully saved allocation
+AllocationMatchedUsers: Newly assigned
+AllocationUnmatchedUsers: Participants without assigned places
+AllocationUnmatchedCourses: Courses without assigned participants
+AllocationTime: Time of allocation
+AllocationRequestedPlaces: Requested places
+AllocationOfferedPlaces: Offered places
+AllocationUserNewMatches: New allocations
+AllocationUsersCount: Participants
+AllocationCoursesCount: Courses
+
+CourseOption tid ssh coursen: #{tid} - #{ssh} - #{coursen}
+
+BearerTokenUsageWarning: Using this interface you are able to encode essentially arbitrary permissions inte bearer tokens. This allows you to freely hand permissions off arbitrarily and without relevant restrictions. Only use this interface if you have discussed the consequences of the specific token, that you want to issue, with an experienced developer!
+BearerTokenAuthorityGroups: Authority (groups)
+BearerTokenAuthorityGroupsTip: All primary users of the groups listed here need to have the requisite permissions to access a route in order for the created token to grant permission to do so as well.
+BearerTokenAuthorityUsers: Authority (users
+BearerTokenAuthorityUsersTip: All users listed here need to have the requisite permissions to access a route in order for the created token to grant permission to do so as well. The user issuing the token using this interface also needs to have permission to access that route (they are automatically added to the list of authorities).
+BearerTokenAuthorityUnknownUser email: Could not find any user with email #{email}
+BearerTokenRoutes: Permitted routes
+BearerTokenRoutesTip: If the token is restricted to certain routes and no routes are listed, the token is valid nowhere.
+BearerTokenRestrictions: Route-specific restrictions
+BearerTokenRestrictRoutes: Restrict token to certain routes
+BearerTokenAdditionalAuth: Additional authorisation
+BearerTokenAdditionalAuthTip: If nothing is entered, no additional authorisation will be performed when the token is used. Mere posession of the token will be sufficient.
+BearerTokenOverrideExpiration: Override expiration time
+BearerTokenExpires: Expiration time
+BearerTokenExpiresTip: If no expiration time is given, the token will not expire. It will be valid forever.
+BearerTokenOverrideStart: Start time
+BearerTokenOverrideStartTip: If no start time is given, only the expiration time will be checked when the token is used.
+
+FaqTitle: Frequently asked questions
+AdditionalFaqs: More frequently asked questions
+
+MultiActionUnknownAction: In a form dependent on the value of a field a value was given for which no form is available
+
+CourseParticipantStateIsActive: Active participants
+CourseParticipantStateIsInactive: Former participants
+CourseParticipantStateIsActiveFilter: View
+CourseUserReRegister: Re-register
+CourseParticipantActive: Participant
+CourseParticipantInactive: Deregistered
+CourseParticipantNoShow: No show
+CourseUserState: State

missing-translations.sh

@@ -6,6 +6,17 @@ typeset -a requiredLangs
 requiredLangs=(de en)
 
 
+fix=1
+while getopts ':f' arg; do
+    case $arg in
+	f) fix=0 ;;
+	\*) print nothing: $OPTARG; exit 2;;
+	\?) print invalid option: $OPTARG; exit 2;;
+    esac
+done
+shift $OPTIND-1
+
+
 function translations() {
     msgFile=$1
 
@@ -67,8 +78,32 @@ for msgDirectory (${msgDirectories}); do
 	done
 
 	# printf ">>> %s\n" ${msgDirectory}
-	diff -u0 --suppress-common-lines -wB ${diffArgs} | grep -vE '^@@.*@@'
+	if [[ $fix != 0 ]]; then
+            if [[ ${#dirMsgFiles} -gt 1 ]]; then
+	        diff -u0 --suppress-common-lines -wB ${diffArgs} | grep -vE '^@@.*@@'
+	        diffStatus=$pipestatus[0]
+            else
+                diffStatus=1
+            fi
+	else
+            if [[ ${#dirMsgFiles} -gt 1 ]]; then
+	        diff -u0 --suppress-common-lines -wB ${diffArgs} >/dev/null
+	        diffStatus=$?
+            else
+                diffStatus=1
+            fi
+
+	    if [[ ${diffStatus} == 1 ]]; then
+		./translate.hs msgs ${dirMsgFiles} && diffStatus=0
+	    fi
+	fi
+
+	return ${diffStatus}
     ) || msgDifference=1
+
+    if [[ $fix == 0 && $msgDifference != 0 ]]; then
+	exit 1
+    fi
 done
 
 
@@ -89,19 +124,46 @@ for templateDirectory (templates/i18n/**/*(FN)); do
 	fi
     done
 
+    typeset -a templatePrefixes
+    templatePrefixes=()
+    for templateFile (${templateFiles}); do
+	[[ ${templateFile:h} == ${templateDirectory} ]] || continue
+
+        templatePrefix=$(sed -r 's/^(.*\.)?[^.]+\.[^.]+$/\1/' <<<"${templateFile:t}")
+
+	if ! ((${templatePrefixes[(Ie)${templatePrefix}]})); then
+	    templatePrefixes+=("${templatePrefix}")
+	fi
+    done
+
+    # printf "%d %s\n" ${#templatePrefixes} "${templatePrefixes}"
+
     for ext (${templateExtensions}); do
 	for lang (${requiredLangs}); do
-	    foundLang=0
+            for prefixQ (${(q)templatePrefixes}); do
-	    for templateFile (${templateDirectory}/*.${ext}); do
+                prefix=${(Q)prefixQ}
-		[[ ${templateFile:t} =~ "(^|.)${lang}[-.]" ]] || continue
+                # printf ">> %s %s %s\n" ${prefix} ${lang} ${ext}
-		foundLang=1
+                
-		break
+	        foundLang=1
-	    done
+	        for templateFile (${templateDirectory}/*.${ext}); do
-
+                    # printf "%s\n" ${templateFile}
-	    if [[ $foundLang -ne 1 ]]; then
+		    [[ ${templateFile:t} =~ "^${prefix}${lang}[-.]" ]] || continue
-		templateDifference=1
+                    # printf "match\n"
-		printf "%s: %s (%s)\n" $templateDirectory $lang $ext
+		    foundLang=0
-	    fi
+		    break
+	        done
+                
+                # printf ">> %s\n" ${foundLang}
+                
+	        if [[ $foundLang -ne 0 ]]; then
+		    templateDifference=1
+		    [[ $fix != 0 ]] && printf "%s: %s*.%s (%s)\n" "$templateDirectory" "$prefix" "$ext" "$lang"
+                    
+		    if [[ $fix == 0 ]]; then
+		        ./translate.hs dir $templateDirectory && templateDifference=0
+		    fi
+	        fi
+            done
 	done
     done
 done

models/allocations.model

@@ -21,6 +21,7 @@ Allocation -- attributes with prefix staff- affect lecturers only, but are invis
     registerByCourse    UTCTime Maybe   -- course registration dates are ignored until this day has passed or always prohibited
     overrideDeregister  UTCTime Maybe   -- course deregistration enforced to be this date, i.e. students may disenrol from course after or never
     -- overrideVisible not needed, since courses are always visible
+    matchingSeed        ByteString default='\x'::bytea
     TermSchoolAllocationShort  term school shorthand    -- shorthand must be unique within school and semester
     TermSchoolAllocationName   term school name         -- name must be unique within school and semester
     deriving Show Eq Ord Generic
@@ -28,6 +29,7 @@ Allocation -- attributes with prefix staff- affect lecturers only, but are invis
 AllocationMatching
     allocation          AllocationId
     fingerprint         AllocationFingerprint
+    time                UTCTime
     log                 FileId
 
 AllocationCourse

models/courses.model

@@ -15,6 +15,7 @@ Course    -- Information about a single course; contained info is always visible
     registerFrom     UTCTime Maybe -- enrolement allowed from a given day onwwards or prohibited
     registerTo       UTCTime Maybe -- enrolement may be prohibited from a given date onwards
     deregisterUntil  UTCTime Maybe -- unenrolement may be prohibited from a given date onwards
+    deregisterNoShow Bool default=false
     registerSecret   Text Maybe    -- enrolement maybe protected by a simple common passphrase
     materialFree     Bool          -- False: only enrolled users may see course materials not stored in this table
     applicationsRequired       Bool default=false
@@ -30,6 +31,7 @@ CourseEvent
     course CourseId
     room Text
     time Occurrences
+    note Html Maybe
     lastChanged UTCTime default=now()
 
 CourseAppInstructionFile
@@ -52,6 +54,7 @@ CourseParticipant                      -- course enrolement
     registration UTCTime               -- time of last enrolement for this course
     field        StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
     allocated    AllocationId Maybe    -- participant was centrally allocated
+    state        CourseParticipantState
     UniqueParticipant user course
 -- Replace the last two by the following, once an audit log is available
 -- CourseUserNote                 -- lecturers of a specific course may share a text note on each enrolled student

models/files.model

@@ -8,7 +8,5 @@ File
     deriving Show Eq Generic
 
 SessionFile
-    user            UserId
-    reference       SessionFileReference
     file            FileId
     touched         UTCTime

models/sheets.model

@@ -12,6 +12,7 @@ Sheet   -- exercise sheet for a given course
     solutionFrom    UTCTime Maybe    -- Solution is made available
     submissionMode  SubmissionMode   -- Submission upload by students and/or through tutors?
     autoDistribute  Bool default=false  -- Should correctors be assigned submissions automagically?
+    anonymousCorrection Bool default=true
     CourseSheet course name
     deriving Generic
 SheetEdit                     -- who edited when a row in table "Course", kept indefinitely

models/submissions.model

@@ -23,12 +23,9 @@ SubmissionUser                    -- which submission belongs to whom
     UniqueSubmissionUser user submission -- multiple users may share same submission, in case of (ad-hoc) submission groups
 SubmissionGroup                   -- pre-defined submission groups; some courses only allow pre-defined submission groups
     course          CourseId
-    name            Text Maybe
+    name            SubmissionGroupName
-SubmissionGroupEdit               -- who edited a submissionGroup when?
+    UniqueSubmissionGroup course name
-    user            UserId
-    time            UTCTime
-    submissionGroup SubmissionGroupId
 SubmissionGroupUser              -- Registered submission groups, just for checking upon submission, but independent of actual SubmissionUser
     submissionGroup     SubmissionGroupId
     user                UserId
-    UniqueSubmissionGroupUser submissionGroup   user
+    UniqueSubmissionGroupUser submissionGroup user

models/system-messages.model

@@ -3,8 +3,12 @@
 SystemMessage
     from                UTCTime Maybe -- Message is not shown before this date has passed (never shown, if null)
     to                  UTCTime Maybe -- Message is shown until this date has passed (shown forever, if null)
+    newsOnly            Bool default=false
     authenticatedOnly   Bool -- Show message to all users upon visiting the site or only upon login?
     severity            MessageStatus -- Success, Warning, Error, Info, ...
+    created             UTCTime default=now()
+    lastChanged         UTCTime default=now()
+    lastUnhide          UTCTime default=now()
     defaultLanguage     Lang -- Language of @content@ and @summary@
     content             Html -- Detailed message shown when clicking on the @summary@-popup or when no @summary@ is specified
     summary             Html Maybe
@@ -14,3 +18,9 @@ SystemMessageTranslation -- Translation of a @SystemMessage@ into another langua
     content             Html
     summary             Html Maybe
     UniqueSystemMessageTranslation message language
+
+SystemMessageHidden
+    message             SystemMessageId
+    user                UserId
+    time                UTCTime
+    UniqueSystemMessageHidden user message

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "13.0.1",
+  "version": "16.0.5",
   "description": "",
   "keywords": [],
   "author": "",
@@ -53,28 +53,28 @@
     "defaults"
   ],
   "devDependencies": {
-    "@babel/cli": "^7.7.5",
+    "@babel/cli": "^7.8.4",
-    "@babel/core": "^7.7.5",
+    "@babel/core": "^7.9.6",
-    "@babel/plugin-proposal-class-properties": "^7.7.4",
+    "@babel/plugin-proposal-class-properties": "^7.8.3",
-    "@babel/plugin-proposal-decorators": "^7.7.4",
+    "@babel/plugin-proposal-decorators": "^7.8.3",
-    "@babel/plugin-transform-runtime": "^7.7.6",
+    "@babel/plugin-transform-runtime": "^7.9.6",
-    "@babel/preset-env": "^7.7.6",
+    "@babel/preset-env": "^7.9.6",
-    "@commitlint/cli": "^8.2.0",
+    "@commitlint/cli": "^8.3.5",
-    "@commitlint/config-conventional": "^8.2.0",
+    "@commitlint/config-conventional": "^8.3.4",
-    "@fortawesome/fontawesome-pro": "^5.12.0",
+    "@fortawesome/fontawesome-pro": "^5.13.0",
-    "autoprefixer": "^9.7.3",
+    "autoprefixer": "^9.7.6",
     "babel-core": "^6.26.3",
-    "babel-eslint": "^10.0.3",
+    "babel-eslint": "^10.1.0",
-    "babel-loader": "^8.0.6",
+    "babel-loader": "^8.1.0",
     "babel-plugin-syntax-dynamic-import": "^6.18.0",
     "babel-plugin-transform-decorators-legacy": "^1.3.5",
     "babel-preset-es2015": "^6.24.1",
     "cbt_tunnels": "^1.2.2",
     "clean-webpack-plugin": "^3.0.0",
-    "copy-webpack-plugin": "^5.1.0",
+    "copy-webpack-plugin": "^5.1.1",
     "css-loader": "^2.1.1",
     "eslint": "^5.16.0",
-    "file-loader": "^5.0.2",
+    "file-loader": "^5.1.0",
     "fs-extra": "^8.1.0",
     "glob": "^7.1.6",
     "html-webpack-plugin": "^3.2.0",
@@ -85,45 +85,45 @@
     "karma-chrome-launcher": "^2.2.0",
     "karma-cli": "^2.0.0",
     "karma-jasmine": "^2.0.1",
-    "karma-jasmine-html-reporter": "^1.4.2",
+    "karma-jasmine-html-reporter": "^1.5.3",
     "karma-mocha-reporter": "^2.2.5",
     "karma-webpack": "^3.0.5",
     "lint-staged": "^8.2.1",
     "lodash.debounce": "^4.0.8",
-    "mini-css-extract-plugin": "^0.8.0",
+    "mini-css-extract-plugin": "^0.8.2",
     "npm-run-all": "^4.1.5",
     "null-loader": "^2.0.0",
     "optimize-css-assets-webpack-plugin": "^5.0.3",
     "postcss-loader": "^3.0.0",
     "postcss-preset-env": "^6.7.0",
     "real-favicon-webpack-plugin": "^0.2.3",
-    "remove-files-webpack-plugin": "^1.1.3",
+    "remove-files-webpack-plugin": "^1.4.1",
-    "request": "^2.88.0",
+    "request": "^2.88.2",
     "request-promise": "^4.2.5",
     "resolve-url-loader": "^3.1.1",
-    "sass": "^1.23.7",
+    "sass": "^1.26.5",
     "sass-loader": "^7.3.1",
     "semver": "^6.3.0",
     "standard-version": "^6.0.1",
     "style-loader": "^0.23.1",
-    "terser-webpack-plugin": "^2.2.3",
+    "terser-webpack-plugin": "^2.3.6",
     "tmp": "^0.1.0",
     "typeface-roboto": "0.0.75",
     "typeface-source-sans-pro": "0.0.75",
-    "webpack": "^4.41.2",
+    "webpack": "^4.43.0",
-    "webpack-cli": "^3.3.10",
+    "webpack-cli": "^3.3.11",
     "webpack-manifest-plugin": "^2.2.0",
     "webpack-plugin-hash-output": "^3.2.1"
   },
   "dependencies": {
-    "@babel/runtime": "^7.7.6",
+    "@babel/runtime": "^7.9.6",
     "@juggle/resize-observer": "^2.5.0",
-    "core-js": "^3.4.8",
+    "core-js": "^3.6.5",
     "js-cookie": "^2.2.1",
     "lodash.throttle": "^4.1.1",
-    "moment": "^2.24.0",
+    "moment": "^2.25.3",
-    "npm": "^6.13.7",
+    "npm": "^6.14.5",
-    "sodium-javascript": "^0.5.5",
+    "sodium-javascript": "^0.5.6",
     "tail.datetime": "git+ssh://git@gitlab2.rz.ifi.lmu.de/uni2work/tail.DateTime.git#master",
     "whatwg-fetch": "^3.0.0"
   }

package.yaml

@@ -1,5 +1,5 @@
 name:    uniworx
-version: 13.0.1
+version: 16.0.5
 
 dependencies:
   - base
@@ -61,6 +61,7 @@ dependencies:
   - cryptoids
   - cryptoids-class
   - binary
+  - binary-instances
   - cereal
   - mtl
   - esqueleto >=3.1.0
@@ -103,7 +104,9 @@ dependencies:
   - postgresql-simple
   - word24
   - mmorph
-  - clientsession
+  - serversession
+  - serversession-backend-acid-state
+  - acid-state
   - monad-memo
   - xss-sanitize
   - text-metrics
@@ -138,7 +141,12 @@ dependencies:
   - wai-middleware-prometheus
   - extended-reals
   - rfc5051
+  - unidecode
   - pandoc
+  - token-bucket
+  - async
+  - pointedlist
+  - clock
 
 other-extensions:
   - GeneralizedNewtypeDeriving
@@ -185,8 +193,10 @@ default-extensions:
   - DeriveFunctor
   - DeriveFoldable
   - DeriveTraversable
+  - DeriveAnyClass
   - DerivingStrategies
   - DerivingVia
+  - GeneralizedNewtypeDeriving
   - DataKinds
   - BinaryLiterals
   - PolyKinds
@@ -227,6 +237,8 @@ library:
           - -ddump-splices
           - -ddump-to-file
         cpp-options: -DDEVELOPMENT
+        ghc-prof-options:
+          - -fprof-auto
       else:
         ghc-options:
           - -O2
@@ -249,7 +261,8 @@ executables:
     source-dirs: test
     dependencies:
       - uniworx
-    other-modules: []
+    other-modules:
+      - Database.Fill
     when:
       - condition: flag(library-only)
         buildable: false

records.json

@@ -815,18 +815,5 @@
         "usedIds": []
       }
     }
-  ],
-  "mini-css-extract-plugin node_modules/css-loader/dist/cjs.js??ref--6-1!node_modules/postcss-loader/src/index.js??ref--6-2!node_modules/resolve-url-loader/index.js??ref--6-3!node_modules/sass-loader/dist/cjs.js??ref--6-4!frontend/src/utils/inputs/radiobox.sass": [
-    {
-      "modules": {
-        "byIdentifier": {},
-        "usedIds": {}
-      },
-      "chunks": {
-        "byName": {},
-        "bySource": {},
-        "usedIds": []
-      }
-    }
   ]
 }

routes

@@ -55,6 +55,7 @@
 /admin/features               AdminFeaturesR   GET POST
 /admin/test                   AdminTestR       GET POST
 /admin/errMsg                 AdminErrMsgR     GET POST
+/admin/tokens                 AdminTokensR     GET POST
 
 /health                       HealthR          GET             !free
 /instance                     InstanceR        GET             !free
@@ -63,6 +64,7 @@
 /info/legal                   LegalR           GET             !free
 /info/allocation              InfoAllocationR  GET             !free
 /info/glossary                GlossaryR        GET             !free
+/info/faq                     FaqR             GET             !free
 /version                      VersionR         GET             !free
 
 /help                         HelpR            GET POST        !free
@@ -110,6 +112,8 @@
   /course/#CryptoUUIDCourse/apply                AApplyR            POST        !timeANDallocation-registered
   /users                                         AUsersR        GET POST        !allocation-admin
   /priorities                                    APriosR        GET POST        !allocation-admin
+  /compute                                       AComputeR      GET POST        !allocation-admin
+  /accept                                        AAcceptR       GET POST        !allocation-admin
 
 /participants                   ParticipantsListR GET            !evaluation
 /participants/#TermId/#SchoolId ParticipantsR     GET            !evaluation
@@ -137,9 +141,9 @@
   /exam-office                CExamOfficeR     GET POST        !course-registered
   /subs                       CCorrectionsR    GET POST
   /subs/assigned              CAssignR         GET POST
-  /sheet                      SheetListR       GET             !course-registered !materials !corrector
+  /sheet                      SheetListR       GET             !course-registered !materials !corrector !tutor
   /sheet/new                  SheetNewR        GET POST
-  /sheet/current              SheetCurrentR    GET             !course-registered !materials !corrector
+  /sheet/current              SheetCurrentR    GET             !course-registered !materials !corrector !tutor
   /sheet/unassigned           SheetOldUnassignedR  GET
   /sheet/#SheetName SheetR:
     /show                       SShowR         GET             !timeANDcourse-registered !timeANDmaterials !corrector !timeANDtutor
@@ -147,15 +151,15 @@
     /edit                       SEditR         GET POST
     /delete                     SDelR          GET POST
     /subs                       SSubsR         GET POST        -- for lecturer only
-    !/subs/new                  SubmissionNewR GET POST        !timeANDcourse-registeredANDuser-submissions
+    !/subs/new                  SubmissionNewR GET POST        !timeANDcourse-registeredANDuser-submissionsANDsubmission-group
     !/subs/own                  SubmissionOwnR GET             !free -- just redirect
     !/subs/assign               SAssignR       GET POST        !lecturerANDtime
     /subs/#CryptoFileNameSubmission SubmissionR:
-      /                         SubShowR       GET POST        !ownerANDtimeANDuser-submissions !ownerANDread !correctorANDread
+      /                         SubShowR       GET POST        !ownerANDtimeANDuser-submissionsANDsubmission-group !ownerANDread !correctorANDread
       /delete                   SubDelR        GET POST        !ownerANDtimeANDuser-submissions
       /assign                   SubAssignR     GET POST        !lecturerANDtime
       /correction               CorrectionR    GET POST        !corrector !ownerANDreadANDrated
-      /invite                   SInviteR       GET POST        !ownerANDtimeANDuser-submissions
+      /invite                   SInviteR       GET POST        !ownerANDtimeANDuser-submissionsANDsubmission-group
       !/#SubmissionFileType     SubArchiveR    GET             !owner !corrector
       !/#SubmissionFileType/*FilePath SubDownloadR  GET        !owner !corrector
     /iscorrector                SIsCorrR       GET             !corrector -- Route is used to check for corrector access to this sheet
@@ -219,8 +223,9 @@
 /subs/download CorrectionsDownloadR  GET      !corrector !lecturer
 
 
-/msgs                           MessageListR GET POST
+/msgs                                MessageListR  GET POST
-/msg/#{CryptoUUIDSystemMessage} MessageR      GET POST        !timeANDreadANDauthentication
+/msg/#{CryptoUUIDSystemMessage}      MessageR      GET POST        !timeANDreadANDauthentication
+/msg/#{CryptoUUIDSystemMessage}/hide MessageHideR      POST        !timeANDauthentication
 
 !/#UUID CryptoUUIDDispatchR GET                               !free -- just redirect
 -- !/*{CI FilePath} CryptoFileNameDispatchR GET                  !free -- Disabled until preliminary check for valid cID exists

shell.nix

@@ -19,11 +19,22 @@ let
   '';
 
   override = oldAttrs: {
-    nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ nodejs-13_x postgresql openldap google-chrome exiftool ]) ++ (with pkgs.haskellPackages; [ stack yesod-bin hlint cabal-install weeder ]);
+    nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ nodejs-13_x postgresql openldap google-chrome exiftool memcached ]) ++ (with pkgs.haskellPackages; [ stack yesod-bin hlint cabal-install weeder profiteur ]);
     shellHook = ''
       export PROMPT_INFO="${oldAttrs.name}"
 
-      export CHROME_BIN=$(which google-chrome-stable)
+      export EDITOR=emacsclient
+
+      cleanup() {
+        set +e -x
+        type cleanup_postgres &>/dev/null && cleanup_postgres
+        type cleanup_widget_memcached &>/dev/null && cleanup_widget_memcached
+        type cleanup_session_memcached &>/dev/null && cleanup_session_memcached
+        type cleanup_cache_memcached &>/dev/null && cleanup_cache_memcached
+        set +x
+      }
+
+      trap cleanup EXIT
 
       if [[ -z "$PGHOST" ]]; then
         set -xe
@@ -37,14 +48,57 @@ let
         psql -f ${postgresSchema} postgres
         printf "Postgres logfile is %s\nPostgres socket directory is %s\n" ''${pgLogFile} ''${pgSockDir}
 
-        cleanup() {
+        cleanup_postgres() {
             set +e -x
             pg_ctl stop -D ''${pgDir}
             rm -rvf ''${pgDir} ''${pgSockDir} ''${pgLogFile}
             set +x
         }
 
-        trap cleanup EXIT
+        set +xe
+      fi
+
+      if [[ -z "$WIDGET_MEMCACHED_HOST" ]]; then
+        set -xe
+
+        memcached -l localhost -p 11211 &>/dev/null &
+        widget_memcached_pid=$?
+
+        cleanup_widget_memcached() {
+          [[ -n "$widget_memcached_pid" ]] && kill $widget_memcached_pid
+        }
+
+        export WIDGET_MEMCACHED_HOST=localhost WIDGET_MEMCACHED_PORT=11211
+
+        set +xe
+      fi
+
+      if [[ -z "$SESSION_MEMCACHED_HOST" ]]; then
+        set -xe
+
+        memcached -l localhost -p 11212 &>/dev/null &
+        session_memcached_pid=$?
+
+        cleanup_session_memcached() {
+          [[ -n "$session_memcached_pid" ]] && kill $session_memcached_pid
+        }
+
+        export SESSION_MEMCACHED_HOST=localhost SESSION_MEMCACHED_PORT=11212
+
+        set +xe
+      fi
+
+      if [[ -z "MEMCACHED_HOST" ]]; then
+        set -xe
+
+        memcached -l localhost -p 11213 &>/dev/null &
+        memcached_pid=$?
+
+        cleanup_session_memcached() {
+          [[ -n "memcached_pid" ]] && kill memcached_pid
+        }
+
+        export MEMCACHED_HOST=localhost MEMCACHED_PORT=11212
 
         set +xe
       fi

src/Application.hs

@@ -18,10 +18,11 @@ module Application
 
 import Control.Monad.Logger                 (liftLoc, LoggingT(..), MonadLoggerIO(..))
 import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
-                                             pgPoolSize, runSqlPool)
+                                             pgPoolSize, runSqlPool, ConnectionPool)
-import Import                        hiding (cancel)
+import Import                        hiding (cancel, respond)
 import Language.Haskell.TH.Syntax           (qLocation)
 import Network.Wai (Middleware)
+import qualified Network.Wai as Wai
 import Network.Wai.Handler.Warp             (Settings, defaultSettings,
                                              defaultShouldDisplayException,
                                              runSettings, runSettingsSocket, setHost,
@@ -40,6 +41,9 @@ import Handler.Utils                        (runAppLoggingT)
 
 import Foreign.Store
 
+import Web.Cookie
+import Network.HTTP.Types.Header (hSetCookie)
+
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as UUID
 
@@ -88,6 +92,9 @@ import qualified Data.Set as Set
 
 import Handler.Utils.Routes (classifyHandler)
 
+import qualified Data.Acid.Memory as Acid
+import qualified Web.ServerSession.Backend.Acid as Acid
+
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
 import Handler.News
@@ -125,7 +132,7 @@ mkYesodDispatch "UniWorX" resourcesUniWorX
 -- performs initialization and returns a foundation datatype value. This is also
 -- the place to put your migrate statements to have automatic database
 -- migrations handled by Yesod.
-makeFoundation :: (MonadResource m, MonadUnliftIO m) => AppSettings -> m UniWorX
+makeFoundation :: (MonadResource m, MonadUnliftIO m, MonadThrow m) => AppSettings -> m UniWorX
 makeFoundation appSettings'@AppSettings{..} = do
     registerGHCMetrics
   
@@ -168,7 +175,7 @@ makeFoundation appSettings'@AppSettings{..} = do
     -- logging function. To get out of this loop, we initially create a
     -- temporary foundation without a real connection pool, get a log function
     -- from there, and then create the real foundation.
-    let mkFoundation appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID = UniWorX {..}
+    let mkFoundation appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached = UniWorX {..}
         -- The UniWorX {..} syntax is an example of record wild cards. For more
         -- information, see:
         -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
@@ -177,11 +184,12 @@ makeFoundation appSettings'@AppSettings{..} = do
           (error "smtpPool forced in tempFoundation")
           (error "ldapPool forced in tempFoundation")
           (error "cryptoIDKey forced in tempFoundation")
-          (error "sessionKey forced in tempFoundation")
+          (error "sessionStore forced in tempFoundation")
           (error "secretBoxKey forced in tempFoundation")
           (error "widgetMemcached forced in tempFoundation")
           (error "JSONWebKeySet forced in tempFoundation")
           (error "ClusterID forced in tempFoundation")
+          (error "memcached forced in tempFoundation")
 
     runAppLoggingT tempFoundation $ do
       $logInfoS "InstanceID" $ UUID.toText appInstanceID
@@ -191,9 +199,9 @@ makeFoundation appSettings'@AppSettings{..} = do
         $logDebugS "setup" "SMTP-Pool"
         createSmtpPool c
 
-      appWidgetMemcached <- for appWidgetMemcachedConf $ \c -> do
+      appWidgetMemcached <- for appWidgetMemcachedConf $ \WidgetMemcachedConf{ widgetMemcachedConf } -> do
         $logDebugS "setup" "Widget-Memcached"
-        createWidgetMemcached c
+        createMemcached widgetMemcachedConf
 
       -- Create the database connection pool
       $logDebugS "setup" "PostgreSQL-Pool"
@@ -201,9 +209,9 @@ makeFoundation appSettings'@AppSettings{..} = do
         (pgConnStr  appDatabaseConf)
         (pgPoolSize appDatabaseConf)
 
-      ldapPool <- for appLdapConf $ \LdapConf{..} -> do
+      ldapPool <- traverse mkFailover <=< forOf (traverse . traverse) appLdapConf $ \conf@LdapConf{..} -> do
-        $logDebugS "setup" "LDAP-Pool"
+        $logDebugS "setup" $ "LDAP-Pool " <> tshow ldapHost
-        createLdapPool ldapHost ldapPort (poolStripes ldapPool) (poolTimeout ldapPool) ldapTimeout (poolLimit ldapPool)
+        (conf,) <$> createLdapPool ldapHost ldapPort (poolStripes ldapPool) (poolTimeout ldapPool) ldapTimeout (poolLimit ldapPool)
 
       -- Perform database migration using our application's logging settings.
       if
@@ -215,17 +223,48 @@ makeFoundation appSettings'@AppSettings{..} = do
             liftIO . exitWith $ ExitFailure 2
       $logDebugS "setup" "Cluster-Config"
       appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool
-      appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool
       appSecretBoxKey <- clusterSetting (Proxy :: Proxy 'ClusterSecretBoxKey) `runSqlPool` sqlPool
       appJSONWebKeySet <- clusterSetting (Proxy :: Proxy 'ClusterJSONWebKeySet) `runSqlPool` sqlPool
       appClusterID <- clusterSetting (Proxy :: Proxy 'ClusterId) `runSqlPool` sqlPool
 
-      let foundation = mkFoundation sqlPool smtpPool ldapPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID
+      appMemcached <- for appMemcachedConf $ \memcachedConf -> do
+        $logDebugS "setup" "Memcached"
+        memcachedKey <- clusterSetting (Proxy :: Proxy 'ClusterMemcachedKey) `runSqlPool` sqlPool
+        memcached <- createMemcached memcachedConf
+        return (memcachedKey, memcached)
+
+      appSessionStore <- mkSessionStore appSettings' sqlPool `runSqlPool` sqlPool
+
+      let foundation = mkFoundation sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached
 
       -- Return the foundation
       $logDebugS "setup" "Done"
       return foundation
 
+data SessionStoreException
+  = SessionStoreNotAvailable
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+instance Exception SessionStoreException
+
+mkSessionStore :: forall m.
+                  ( MonadIO m
+                  , MonadLogger m
+                  , MonadThrow m
+                  , MonadResource m
+                  )
+               => AppSettings -> ConnectionPool -> ReaderT SqlBackend m SomeSessionStorage
+mkSessionStore AppSettings{..} mcdSqlConnPool
+  | Just mcdConf@MemcachedConf{..} <- appSessionMemcachedConf = do
+      mcdSqlMemcachedKey <- clusterSetting (Proxy :: Proxy 'ClusterServerSessionKey)
+      $logDebugS "setup" "Session-Memcached"
+      mcdSqlMemcached <- createMemcached mcdConf
+      let mcdSqlMemcachedExpiration = memcachedExpiry
+      return $ _SessionStorageMemcachedSql # MemcachedSqlStorage{..}
+  | appServerSessionAcidFallback = liftIO $
+      review _SessionStorageAcid . Acid.AcidStorage <$> Acid.openMemoryState Acid.emptyState
+  | otherwise = throwM SessionStoreNotAvailable
+
+
 clusterSetting :: forall key m p.
                   ( MonadIO m
                   , ClusterSetting key
@@ -285,8 +324,8 @@ createSmtpPool SmtpConf{ smtpPool = ResourcePoolConf{..}, .. } = do
       return conn
   liftIO $ createPool (mkConnection >>= maybe return applyAuth smtpAuth) reapConnection poolStripes poolTimeout poolLimit
 
-createWidgetMemcached :: (MonadLogger m, MonadResource m) => WidgetMemcachedConf -> m Memcached.Connection
+createMemcached :: (MonadLogger m, MonadResource m) => MemcachedConf -> m Memcached.Connection
-createWidgetMemcached WidgetMemcachedConf{widgetMemcachedConnectInfo} = snd <$> allocate (Memcached.connect widgetMemcachedConnectInfo) Memcached.close
+createMemcached MemcachedConf{memcachedConnectInfo} = snd <$> allocate (Memcached.connect memcachedConnectInfo) Memcached.close
 
 -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
 -- applying some additional middlewares.
@@ -295,7 +334,33 @@ makeApplication foundation = liftIO $ do
     logWare <- makeLogWare foundation
     -- Create the WAI application and apply middlewares
     appPlain <- toWaiAppPlain foundation
-    return . observeHTTPRequestLatency classifyHandler . logWare $ defaultMiddlewaresNoLogging appPlain
+    return . observeHTTPRequestLatency classifyHandler . logWare . normalizeCookies $ defaultMiddlewaresNoLogging appPlain
+  where
+    normalizeCookies :: Wai.Middleware
+    normalizeCookies app req respond = app req $ \res -> do
+        resHdrs' <- go $ Wai.responseHeaders res
+        respond $ Wai.mapResponseHeaders (const resHdrs') res
+      where parseSetCookie' :: ByteString -> IO (Maybe SetCookie)
+            parseSetCookie' = fmap (either (\(_ :: SomeException) -> Nothing) Just) . try . evaluate . force . parseSetCookie
+              
+            go [] = return []
+            go (hdr@(hdrName, hdrValue) : hdrs)
+              | hdrName == hSetCookie = do
+                  mcookieHdr <- parseSetCookie' hdrValue
+                  case mcookieHdr of
+                    Nothing -> (hdr :) <$> go hdrs
+                    Just cookieHdr -> do
+                      let cookieHdrMatches hdrValue' = maybeT (return False) $ do
+                            cookieHdr' <- MaybeT $ parseSetCookie' hdrValue'
+                            -- See https://tools.ietf.org/html/rfc6265
+                            guard $ setCookiePath     cookieHdr' == setCookiePath     cookieHdr
+                            guard $ setCookieName     cookieHdr' == setCookieName     cookieHdr
+                            guard $ setCookieDomain   cookieHdr' == setCookieDomain   cookieHdr
+                            return True
+                      others <- filterM (\(hdrName', hdrValue') -> and2M (pure $ hdrName' == hSetCookie) (cookieHdrMatches hdrValue')) hdrs
+                      if | null others -> (hdr :) <$> go hdrs
+                         | otherwise   -> go hdrs
+              | otherwise = (hdr :) <$> go hdrs
 
 makeLogWare :: MonadIO m => UniWorX -> m Middleware
 makeLogWare app = do
@@ -432,12 +497,12 @@ appMain = runResourceT $ do
       case watchdogMicroSec of
         Just wInterval
           | maybe True (== myProcessID) watchdogProcess
-            -> let notifyWatchdog :: forall a. IO a
+            -> let notifyWatchdog :: forall a m'. ( MonadLogger m', MonadIO m') => m' a
-                   notifyWatchdog = runAppLoggingT foundation $ go Nothing
+                   notifyWatchdog = go Nothing
                      where
-                       go :: Maybe (Set (UTCTime, HealthReport)) -> LoggingT IO a
+                       go :: Maybe (Set (UTCTime, HealthReport)) -> m' a
                        go pResults = do
-                         let delay = floor $ wInterval % 2
+                         let delay = floor $ wInterval % 4
                          d <- liftIO $ newDelay delay
 
                          $logDebugS "Notify" $ "Waiting up to " <> tshow delay <> "µs..."

src/Audit/Types.hs

@@ -178,6 +178,16 @@ data Transaction
     , transactionUser         :: UserId
     }
 
+  | TransactionSubmissionGroupSet
+    { transactionCourse       :: CourseId
+    , transactionUser         :: UserId
+    , transactionSubmissionGroup :: SubmissionGroupName
+    }
+  | TransactionSubmissionGroupUnset
+    { transactionCourse       :: CourseId
+    , transactionUser         :: UserId
+    }
+
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 deriveJSON defaultOptions

src/Auth/LDAP.hs

@@ -3,6 +3,7 @@ module Auth.LDAP
   , campusLogin
   , CampusUserException(..)
   , campusUser, campusUser'
+  , campusUserReTest, campusUserReTest'
   , campusUserMatr, campusUserMatr'
   , CampusMessage(..)
   , ldapUserPrincipalName, ldapUserEmail, ldapUserDisplayName
@@ -102,8 +103,18 @@ instance Exception CampusUserException
 
 makePrisms ''CampusUserException
 
-campusUser :: MonadUnliftIO m => LdapConf -> LdapPool -> Creds site -> m (Ldap.AttrList [])
+campusUserWith :: MonadUnliftIO m
-campusUser conf@LdapConf{..} pool Creds{..} = liftIO . (`catches` errHandlers) $ either (throwM . CampusUserLdapError) return <=< withLdap pool $ \ldap -> do
+               => (    Lens (LdapConf, LdapPool) (LdapConf, Ldap) LdapPool Ldap
+                    -> Failover (LdapConf, LdapPool)
+                    -> FailoverMode
+                    -> ((LdapConf, Ldap) -> IO (Ldap.AttrList []))
+                    -> IO (Either LdapPoolError (Ldap.AttrList []))
+                  )
+               -> Failover (LdapConf, LdapPool)
+               -> FailoverMode
+               -> Creds site
+               -> m (Ldap.AttrList [])
+campusUserWith withLdap' pool mode Creds{..} = liftIO . (`catches` errHandlers) $ either (throwM . CampusUserLdapError) return <=< withLdap' _2 pool mode $ \(conf@LdapConf{..}, ldap) -> do
   Ldap.bind ldap ldapDn ldapPassword
   results <- case lookup "DN" credsExtra of
     Just userDN -> do
@@ -121,13 +132,23 @@ campusUser conf@LdapConf{..} pool Creds{..} = liftIO . (`catches` errHandlers) $
                   , Exc.Handler $ \(HostCannotConnect host excs) -> throwM $ CampusUserHostCannotConnect host excs
                   ]
 
-campusUser' :: (MonadCatch m, MonadUnliftIO m) => LdapConf -> LdapPool -> User -> m (Maybe (Ldap.AttrList []))
+campusUserReTest  :: MonadUnliftIO m => Failover (LdapConf, LdapPool) -> (Nano -> Bool) -> FailoverMode -> Creds site -> m (Ldap.AttrList [])
-campusUser' conf pool User{userIdent}
+campusUserReTest pool doTest = campusUserWith (\l -> flip (withLdapFailoverReTest l) doTest) pool
-  = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUser conf pool (Creds apLdap (CI.original userIdent) [])
+
+campusUserReTest' :: (MonadCatch m, MonadUnliftIO m) => Failover (LdapConf, LdapPool) -> (Nano -> Bool) -> FailoverMode -> User -> m (Maybe (Ldap.AttrList []))
+campusUserReTest' pool doTest mode User{userIdent}
+  = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUserReTest pool doTest mode (Creds apLdap (CI.original userIdent) [])
+
+campusUser :: MonadUnliftIO m => Failover (LdapConf, LdapPool) -> FailoverMode -> Creds site -> m (Ldap.AttrList [])
+campusUser = campusUserWith withLdapFailover
+
+campusUser' :: (MonadCatch m, MonadUnliftIO m) => Failover (LdapConf, LdapPool) -> FailoverMode -> User -> m (Maybe (Ldap.AttrList []))
+campusUser' pool mode User{userIdent}
+  = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) $ campusUser pool mode (Creds apLdap (CI.original userIdent) [])
 
 
-campusUserMatr :: MonadUnliftIO m => LdapConf -> LdapPool -> UserMatriculation -> m (Ldap.AttrList [])
+campusUserMatr :: MonadUnliftIO m => Failover (LdapConf, LdapPool) -> FailoverMode -> UserMatriculation -> m (Ldap.AttrList [])
-campusUserMatr conf@LdapConf{..} pool userMatr = liftIO . (`catches` errHandlers) $ either (throwM . CampusUserLdapError) return <=< withLdap pool $ \ldap -> do
+campusUserMatr pool mode userMatr = liftIO . (`catches` errHandlers) $ either (throwM . CampusUserLdapError) return <=< withLdapFailover _2 pool mode $ \(conf@LdapConf{..}, ldap) -> do
   Ldap.bind ldap ldapDn ldapPassword
   results <- findUserMatr conf ldap userMatr []
   case results of
@@ -140,9 +161,9 @@ campusUserMatr conf@LdapConf{..} pool userMatr = liftIO . (`catches` errHandlers
                   , Exc.Handler $ \(HostCannotConnect host excs) -> throwM $ CampusUserHostCannotConnect host excs
                   ]
   
-campusUserMatr' :: (MonadCatch m, MonadUnliftIO m) => LdapConf -> LdapPool -> UserMatriculation -> m (Maybe (Ldap.AttrList []))
+campusUserMatr' :: (MonadCatch m, MonadUnliftIO m) => Failover (LdapConf, LdapPool) -> FailoverMode -> UserMatriculation -> m (Maybe (Ldap.AttrList []))
-campusUserMatr' conf pool
+campusUserMatr' pool mode
-  = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) . campusUserMatr conf pool
+  = runMaybeT . catchIfMaybeT (is _CampusUserNoResult) . campusUserMatr pool mode
 
 
 
@@ -168,8 +189,8 @@ campusLogin :: forall site.
                , RenderMessage site CampusMessage
                , RenderMessage site AFormMessage
                , Button site ButtonSubmit
-               ) => LdapConf -> LdapPool -> AuthPlugin site
+               ) => Failover (LdapConf, LdapPool) -> FailoverMode -> AuthPlugin site
-campusLogin conf@LdapConf{..} pool = AuthPlugin{..}
+campusLogin pool mode = AuthPlugin{..}
   where
     apName :: Text
     apName = apLdap
@@ -184,7 +205,7 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..}
           redirect $ tp LoginR
         FormMissing -> redirect $ tp LoginR
         FormSuccess CampusLogin{ campusIdent = CI.original -> campusIdent, ..} -> do
-          ldapResult <- withLdap pool $ \ldap -> liftIO $ do
+          ldapResult <- withLdapFailover _2 pool mode $ \(conf@LdapConf{..}, ldap) -> liftIO $ do
             Ldap.bind ldap ldapDn ldapPassword
             searchResults <- findUser conf ldap campusIdent [ldapUserPrincipalName]
             case searchResults of

src/Crypto/Hash/Instances.hs

@@ -43,3 +43,6 @@ instance HashAlgorithm hash => ToJSON (Digest hash) where
 
 instance HashAlgorithm hash => FromJSON (Digest hash) where
   parseJSON = withText "Digest" $ either (fail . unpack) return . parseUrlPiece
+
+instance Hashable (Digest hash) where
+  hashWithSalt s = (hashWithSalt s :: ByteString -> Int) . convert

src/Crypto/Random/Instances.hs

@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Crypto.Random.Instances
+  (
+  ) where
+
+import ClassyPrelude
+
+import Crypto.Random
+import System.Random (RandomGen(..))
+
+import qualified Data.ByteArray as BA
+
+import Data.Bits
+
+
+instance RandomGen ChaChaDRG where
+  next g = withRandomBytes g (finiteBitSize (maxBound :: Int) `div` 8) (foldr (\x acc -> acc `shiftL` 8 .|. fromIntegral x) zeroBits . BA.unpack @BA.Bytes)
+  split g = withDRG g drgNew

src/CryptoID.hs

@@ -15,9 +15,9 @@ import Model
 import CryptoID.TH
 
 import qualified Data.CryptoID as E
-import Data.CryptoID.Poly.ImplicitNamespace
+import Data.CryptoID.Poly.ImplicitNamespace hiding (decrypt, encrypt)
-import Data.UUID.Cryptographic.ImplicitNamespace
+import Data.UUID.Cryptographic.ImplicitNamespace hiding (decrypt, encrypt)
-import System.FilePath.Cryptographic.ImplicitNamespace
+import System.FilePath.Cryptographic.ImplicitNamespace hiding (decrypt, encrypt)
 
 import qualified Data.Text as Text
 
@@ -28,6 +28,28 @@ import Data.Aeson.Encoding (text)
 
 import Text.Blaze (ToMarkup(..))
 
+import qualified Data.CryptoID.Class.ImplicitNamespace as I
+
+
+encrypt :: forall plaintext ciphertext m.
+           ( I.HasCryptoID ciphertext plaintext m
+           , KnownSymbol (CryptoIDNamespace ciphertext plaintext)
+           , MonadHandler m
+           , Typeable ciphertext
+           , PathPiece plaintext
+           )
+        => plaintext -> m (I.CryptoID ciphertext plaintext) 
+encrypt plain = $cachedHereBinary (toPathPiece plain) $ I.encrypt plain
+
+decrypt :: forall plaintext ciphertext m.
+           ( I.HasCryptoID ciphertext plaintext m
+           , MonadHandler m
+           , Typeable plaintext
+           , PathPiece ciphertext
+           )
+        => I.CryptoID ciphertext plaintext -> m plaintext 
+decrypt cipher = $cachedHereBinary (toPathPiece $ ciphertext cipher) $ I.decrypt cipher
+
 
 instance {-# OVERLAPPING #-} MonadThrow m => MonadCrypto (ReaderT CryptoIDKey m) where
   type MonadCryptoKey (ReaderT CryptoIDKey m) = CryptoIDKey

src/Data/Aeson/Types/Instances.hs

@@ -9,11 +9,6 @@ import ClassyPrelude
 import Data.Aeson.Types (Parser, Value)
 import Control.Monad.Catch
 
-import Data.Binary (Binary)
-
-import Data.HashMap.Strict.Instances ()
-import Data.Vector.Instances ()
-
 import Model.Types.TH.JSON (derivePersistFieldJSON)
 
 import Control.Monad.Fail
@@ -22,7 +17,5 @@ import Control.Monad.Fail
 instance MonadThrow Parser where
   throwM = fail . show
 
-instance Binary Value
-
 
 derivePersistFieldJSON ''Value

src/Data/CaseInsensitive/Instances.hs

@@ -26,9 +26,6 @@ import qualified Database.Esqueleto as E
 
 import Web.HttpApiData
 
-import Data.Binary (Binary)
-import qualified Data.Binary as Binary
-
 import qualified Data.Csv as Csv
 
 
@@ -99,11 +96,6 @@ instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where
   fromPathMultiPiece = fmap CI.mk . fromPathMultiPiece
   toPathMultiPiece = toPathMultiPiece . CI.original
 
-instance (CI.FoldCase s, Binary s) => Binary (CI s) where
-  get = CI.mk <$> Binary.get
-  put = Binary.put . CI.original
-  putList = Binary.putList . map CI.original
-
 instance Csv.ToField s => Csv.ToField (CI s) where
   toField = Csv.toField . CI.original
 

src/Data/HashMap/Strict/Instances.hs

@@ -1,15 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Data.HashMap.Strict.Instances
-  (
-  ) where
-
-import ClassyPrelude
-
-import Data.Binary (Binary(..))
-import qualified Data.HashMap.Strict as HashMap
-
-
-instance (Binary k, Binary v, Hashable k, Eq k) => Binary (HashMap k v) where
-  put = put . HashMap.toList
-  get = HashMap.fromList <$> get

src/Data/HashSet/Instances.hs

@@ -1,16 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Data.HashSet.Instances
-  (
-  ) where
-
-import ClassyPrelude
-
-import qualified Data.HashSet as HashSet
-
-import Data.Binary (Binary(..))
-
-
-instance (Binary a, Hashable a, Eq a) => Binary (HashSet a) where
-  get = HashSet.fromList <$> get
-  put = put . HashSet.toList

src/Data/MonoTraversable/Instances.hs

@@ -0,0 +1,38 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Data.MonoTraversable.Instances
+  () where
+
+import ClassyPrelude
+
+import Data.Monoid (Any(..), All(..))
+
+
+type instance Element Any = Bool
+type instance Element All = Bool
+
+instance MonoFunctor Any where
+  omap f = Any . f . getAny
+
+instance MonoFunctor All where
+  omap f = All . f . getAll
+
+instance MonoPointed Any where
+  opoint = Any
+  
+instance MonoPointed All where
+  opoint = All
+
+instance MonoFoldable Any where
+  ofoldMap f = f . getAny
+  ofoldr f x (Any b) = f b x
+  ofoldl' f x (Any b) = f x b
+  ofoldr1Ex _ = getAny
+  ofoldl1Ex' _ = getAny
+
+instance MonoFoldable All where
+  ofoldMap f = f . getAll
+  ofoldr f x (All b) = f b x
+  ofoldl' f x (All b) = f x b
+  ofoldr1Ex _ = getAll
+  ofoldl1Ex' _ = getAll

src/Data/NonNull/Instances.hs

@@ -28,3 +28,7 @@ instance Hashable a => Hashable (NonNull a) where
 instance (Binary a, MonoFoldable a) => Binary (NonNull a) where
   get = Binary.get >>= maybe (fail "Expected non-empty structure") return . fromNullable
   put = Binary.put . toNullable
+
+
+instance NFData a => NFData (NonNull a) where
+  rnf = rnf . toNullable

src/Data/Time/Calendar/Instances.hs

@@ -6,7 +6,6 @@ module Data.Time.Calendar.Instances
   ) where
 
 import ClassyPrelude
-import Data.Binary (Binary)
 
 import Data.Time.Calendar
 
@@ -14,7 +13,6 @@ import Data.Universe
 
 
 deriving newtype instance Hashable Day
-deriving newtype instance Binary Day
 
 deriving instance Ord DayOfWeek
 instance Universe DayOfWeek where

src/Data/Time/Clock/Instances.hs

@@ -1,8 +1,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.Time.Clock.Instances
-  ( iso8601OutputFormat, iso8601ParseFormat
+  () where
-  ) where
 
 import ClassyPrelude
 
@@ -10,19 +9,21 @@ import Database.Persist.Sql
 
 import Data.Proxy
 
-import Data.Binary (Binary)
-import qualified Data.Binary as Binary
-
 import Data.Time.Clock
 import Data.Time.Calendar.Instances ()
 import Web.PathPieces
 
 import qualified Data.Csv as Csv
 
+import Data.Time.Format.ISO8601
+
 
 instance Hashable DiffTime where
   hashWithSalt s = hashWithSalt s . toRational
 
+instance Hashable NominalDiffTime where
+  hashWithSalt s = hashWithSalt s . toRational
+
 instance PersistField NominalDiffTime where
   toPersistValue   = toPersistValue . toRational
   fromPersistValue = fmap fromRational . fromPersistValue
@@ -31,27 +32,15 @@ instance PersistFieldSql NominalDiffTime where
   sqlType _ = sqlType (Proxy @Rational)
 
 
-iso8601OutputFormat, iso8601ParseFormat :: String
-iso8601OutputFormat = "%0Y-%m-%dT%H:%M:%S%Q%z"
-iso8601ParseFormat = "%Y-%m-%dT%H:%M:%S%Q%z"
-
-
 deriving instance Generic UTCTime
 instance Hashable UTCTime
 
 instance PathPiece UTCTime where
-  toPathPiece = pack . formatTime defaultTimeLocale iso8601OutputFormat
+  toPathPiece = pack . iso8601Show
-  fromPathPiece = parseTimeM False defaultTimeLocale iso8601ParseFormat . unpack
+  fromPathPiece = iso8601ParseM . unpack
 
 instance Csv.ToField UTCTime where
-  toField = Csv.toField . formatTime defaultTimeLocale iso8601OutputFormat
+  toField = Csv.toField . iso8601Show
 
 instance Csv.FromField UTCTime where
-  parseField = parseTimeM False defaultTimeLocale iso8601ParseFormat <=< Csv.parseField
+  parseField = iso8601ParseM <=< Csv.parseField
-
-
-instance Binary DiffTime where
-  get = fromRational <$> Binary.get
-  put = Binary.put . toRational
-
-instance Binary UTCTime

src/Data/Time/LocalTime/Instances.hs

@@ -8,28 +8,13 @@ import ClassyPrelude
 
 import Data.Time.LocalTime
 
-import Data.Binary (Binary)
-
 import qualified Language.Haskell.TH.Syntax as TH
 
-import qualified Data.Csv as Csv
-
-import Data.Time.Clock.Instances
-  ( iso8601OutputFormat, iso8601ParseFormat
-  )
-
 
 deriving instance Generic TimeOfDay
 deriving instance Typeable TimeOfDay
 
 instance Hashable TimeOfDay
-instance Binary TimeOfDay
 
 
 deriving instance TH.Lift TimeZone
-
-instance Csv.ToField ZonedTime where
-  toField = Csv.toField . formatTime defaultTimeLocale iso8601OutputFormat
-
-instance Csv.FromField ZonedTime where
-  parseField = parseTimeM False defaultTimeLocale iso8601ParseFormat <=< Csv.parseField

src/Data/Vector/Instances.hs

@@ -1,17 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Data.Vector.Instances
-  (
-  ) where
-
-import ClassyPrelude
-
-import qualified Data.Vector as Vector
-
-import Data.Binary (Binary)
-import qualified Data.Binary as Binary
-
-
-instance Binary a => Binary (Vector a) where
-  get = Vector.fromList <$> Binary.get
-  put = Binary.put . Vector.toList

src/Database/Persist/Class/Instances.hs

@@ -13,6 +13,7 @@ import Database.Persist.Sql
 
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary
+import Data.Binary.Instances ()
 
 import qualified Data.Map as Map
 

src/Database/Persist/Types/Instances.hs

@@ -11,6 +11,7 @@ import Database.Persist.Types
 import Data.Time.Calendar.Instances ()
 import Data.Time.LocalTime.Instances ()
 import Data.Time.Clock.Instances ()
+import Data.Binary.Instances ()
 
 import Data.Binary (Binary)
 

src/Foundation/I18n.hs

@@ -277,6 +277,15 @@ instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where
       mr :: RenderMessage UniWorX msg => msg -> Text
       mr = renderMessage foundation ls
 
+instance RenderMessage UniWorX CourseParticipantState where
+  renderMessage foundation ls = \case
+    CourseParticipantActive         -> mr MsgCourseParticipantActive
+    CourseParticipantInactive False -> mr MsgCourseParticipantInactive
+    CourseParticipantInactive True  -> mr MsgCourseParticipantNoShow
+    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

src/Foundation/Type.hs

@@ -1,19 +1,20 @@
 module Foundation.Type
   ( UniWorX(..)
+  , SomeSessionStorage(..)
+  , _SessionStorageMemcachedSql, _SessionStorageAcid
   , SMTPPool
-  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionKey, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport
+  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _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 qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import qualified Crypto.Saltine.Core.AEAD as AEAD
 import qualified Jose.Jwk as Jose
 
 import qualified Database.Memcached.Binary.IO as Memcached
@@ -21,36 +22,47 @@ import qualified Database.Memcached.Binary.IO as Memcached
 
 type SMTPPool = Pool SMTPConnection
 
+data SomeSessionStorage
+  = SessionStorageMemcachedSql { sessionStorageMemcachedSql :: MemcachedSqlStorage SessionMap }
+  | SessionStorageAcid { sessionStorageAcid :: AcidStorage SessionMap }
+
+makePrisms ''SomeSessionStorage
+
 -- | 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
+    { appSettings'        :: AppSettings
-    , appStatic          :: EmbeddedStatic -- ^ Settings for static file serving.
+    , appStatic           :: EmbeddedStatic -- ^ Settings for static file serving.
-    , appConnPool        :: ConnectionPool -- ^ Database connection pool.
+    , appConnPool         :: ConnectionPool -- ^ Database connection pool.
-    , appSmtpPool        :: Maybe SMTPPool
+    , appSmtpPool         :: Maybe SMTPPool
-    , appLdapPool        :: Maybe LdapPool
+    , appLdapPool         :: Maybe (Failover (LdapConf, LdapPool))
-    , appWidgetMemcached :: Maybe Memcached.Connection -- ^ Actually a proper pool
+    , appWidgetMemcached  :: Maybe Memcached.Connection -- ^ Actually a proper pool
-    , appHttpManager     :: Manager
+    , appHttpManager      :: Manager
-    , appLogger          :: (ReleaseKey, TVar Logger)
+    , appLogger           :: (ReleaseKey, TVar Logger)
-    , appLogSettings     :: TVar LogSettings
+    , appLogSettings      :: TVar LogSettings
-    , appCryptoIDKey     :: CryptoIDKey
+    , appCryptoIDKey      :: CryptoIDKey
-    , appClusterID       :: ClusterId
+    , appClusterID        :: ClusterId
-    , appInstanceID      :: InstanceId
+    , appInstanceID       :: InstanceId
-    , appJobState        :: TMVar JobState
+    , appJobState         :: TMVar JobState
-    , appSessionKey      :: ClientSession.Key
+    , appSessionStore     :: SomeSessionStorage
-    , appSecretBoxKey    :: SecretBox.Key
+    , appSecretBoxKey     :: SecretBox.Key
-    , appJSONWebKeySet   :: Jose.JwkSet
+    , appJSONWebKeySet    :: Jose.JwkSet
-    , appHealthReport    :: TVar (Set (UTCTime, HealthReport))
+    , appHealthReport     :: TVar (Set (UTCTime, HealthReport))
+    , appMemcached        :: Maybe (AEAD.Key, Memcached.Connection)
     }
 
 makeLenses_ ''UniWorX
 instance HasInstanceID UniWorX InstanceId where
   instanceID = _appInstanceID
+instance HasClusterID UniWorX ClusterId where
+  clusterID = _appClusterID
 instance HasJSONWebKeySet UniWorX Jose.JwkSet where
   jsonWebKeySet = _appJSONWebKeySet
 instance HasHttpManager UniWorX Manager where
   httpManager = _appHttpManager
 instance HasAppSettings UniWorX where
   appSettings = _appSettings'
+instance HasCookieSettings RegisteredCookie UniWorX where
+  getCookieSettings = appCookieSettings . appSettings'

src/Foundation/Types.hs

@@ -0,0 +1,17 @@
+module Foundation.Types
+  ( UpsertCampusUserMode(..)
+  , _UpsertCampusUser, _UpsertCampusUserDummy, _UpsertCampusUserOther
+  , _upsertCampusUserIdent
+  ) where
+
+import Import.NoFoundation
+
+
+data UpsertCampusUserMode
+  = UpsertCampusUser
+  | UpsertCampusUserDummy { upsertCampusUserIdent :: UserIdent }
+  | UpsertCampusUserOther { uspertCampusUserIdent :: UserIdent }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+makeLenses_ ''UpsertCampusUserMode
+makePrisms ''UpsertCampusUserMode

src/Handler/Admin.hs

@@ -9,6 +9,7 @@ import Handler.Utils
 import Handler.Admin.Test as Handler.Admin
 import Handler.Admin.ErrorMessage as Handler.Admin
 import Handler.Admin.StudyFeatures as Handler.Admin
+import Handler.Admin.Tokens as Handler.Admin
 
 
 getAdminR :: Handler Html

src/Handler/Admin/ErrorMessage.hs

@@ -6,8 +6,6 @@ import Import
 import Handler.Utils
 import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
 
-import Control.Monad.Trans.Except
-
 
 getAdminErrMsgR, postAdminErrMsgR :: Handler Html
 getAdminErrMsgR = postAdminErrMsgR

src/Handler/Admin/StudyFeatures.hs

@@ -330,7 +330,6 @@ postAdminFeaturesR = do
             [ sortable (Just "key")   (i18nCell MsgGenericKey)  (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
             , sortable (Just "name")  (i18nCell MsgDegreeName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName) (_dbrOutput . _entityKey))
             , sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand) (_dbrOutput . _entityKey))
-            , dbRow
             ]
           dbtSorting    = Map.fromList
             [ ("key"  , SortColumn (E.^. StudyDegreeKey))
@@ -356,13 +355,13 @@ postAdminFeaturesR = do
           dbtSQLQuery = return
           dbtRowKey = (E.^. StudyTermsKey)
           dbtProj field@(view _dbrOutput -> Entity fId _) = do
-            fieldSchools <- fmap (setOf $ folded . _Value) . lift . E.select . E.from $ \school -> do
+            fieldSchools <- fmap (setOf $ folded . _Value) . E.select . E.from $ \school -> do
               E.where_ . E.exists . E.from $ \schoolTerms ->
                 E.where_ $ schoolTerms E.^. SchoolTermsSchool E.==. school E.^. SchoolId
                      E.&&. schoolTerms E.^. SchoolTermsTerms  E.==. E.val fId 
               E.where_ $ school E.^. SchoolShorthand `E.in_` E.valList (toListOf (folded . _entityKey . _SchoolId) schools)
               return $ school E.^. SchoolId
-            fieldParents <- fmap (setOf folded) . lift . E.select . E.from $ \terms -> do
+            fieldParents <- fmap (setOf folded) . E.select . E.from $ \terms -> do
               E.where_ . E.exists . E.from $ \subTerms ->
                 E.where_ $ subTerms E.^. StudySubTermsChild E.==. E.val fId
                      E.&&. subTerms E.^. StudySubTermsParent E.==. terms E.^. StudyTermsId
@@ -379,7 +378,6 @@ postAdminFeaturesR = do
             , sortable (Just "field-type") (i18nCell MsgStudyTermsDefaultFieldType)    (fieldTypeCell _6 (_dbrOutput . _1 . _entityVal . _studyTermsDefaultType) _dbrKey')
             , flip foldMap schools $ \(Entity ssh School{schoolName}) ->
                 sortable Nothing (cell $ toWidget schoolName) (checkboxCell (_3 . at ssh . _Maybe) (_dbrOutput . _3 . at ssh . _Maybe) _dbrKey')
-            , dbRow
             ]
           dbtSorting    = Map.fromList
             [ ("key"   , SortColumn $ queryField >>> (E.^. StudyTermsKey))
@@ -416,8 +414,7 @@ postAdminFeaturesR = do
           dbtRowKey     = (E.^. StudyTermNameCandidateId)
           dbtProj       = return
           dbtColonnade  = dbColonnade $ mconcat
-            [ dbRow
+            [ sortable (Just "key")       (i18nCell MsgStudyTermsKey)           (numCell  . view (_dbrOutput . _entityVal . _studyTermNameCandidateKey))
-            , sortable (Just "key")       (i18nCell MsgStudyTermsKey)           (numCell  . view (_dbrOutput . _entityVal . _studyTermNameCandidateKey))
             , sortable (Just "name")      (i18nCell MsgStudyTermsName)          (textCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateName))
             , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateIncidence))
             ]
@@ -459,8 +456,7 @@ postAdminFeaturesR = do
           dbtRowKey = queryCandidate >>> (E.^. StudySubTermParentCandidateId)
           dbtProj       = return
           dbtColonnade  = dbColonnade $ mconcat
-            [ dbRow
+            [ sortable (Just "child") (i18nCell MsgStudySubTermsChildKey)   (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateKey))
-            , sortable (Just "child") (i18nCell MsgStudySubTermsChildKey)   (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateKey))
             , sortable (Just "child-name") (i18nCell MsgStudySubTermsChildName)  (maybe mempty i18nCell . preview (_dbrOutput . _3 . _Just . _entityVal . _studyTermsName . _Just))
             , sortable (Just "parent") (i18nCell MsgStudySubTermsParentKey)  (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateParent))
             , sortable (Just "parent-name") (i18nCell MsgStudySubTermsParentName) (maybe mempty i18nCell . preview (_dbrOutput . _2 . _Just . _entityVal . _studyTermsName . _Just))
@@ -501,8 +497,7 @@ postAdminFeaturesR = do
           dbtRowKey = queryCandidate >>> (E.^. StudyTermStandaloneCandidateId)
           dbtProj       = return
           dbtColonnade  = formColonnade $ mconcat
-            [ dbRow
+            [ sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateKey))
-            , sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateKey))
             , sortable (Just "name") (i18nCell MsgStudyTermsName) (maybe mempty i18nCell . preview (_dbrOutput . _2 . _Just . _entityVal . _studyTermsName . _Just))
             , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateIncidence))
             , sortable Nothing (i18nCell MsgStudyTermsDefaultDegree) (degreeCell _1 (pre $ _dbrOutput . _2 . _Just . _studyTermsDefaultDegree . _Just) _dbrKey')

src/Handler/Admin/Tokens.hs

@@ -0,0 +1,101 @@
+module Handler.Admin.Tokens
+  ( getAdminTokensR, postAdminTokensR
+  ) where
+
+import Import
+import Handler.Utils
+
+import qualified Data.HashSet as HashSet
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Set as Set
+
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Encode.Pretty as Aeson
+
+import Data.Map ((!), (!?))
+
+import qualified Data.Text as Text
+
+
+data BearerTokenForm = BearerTokenForm
+  { btfAuthority :: HashSet (Either UserGroupName UserId)
+  , btfRoutes    :: Maybe (HashSet (Route UniWorX))
+  , btfRestrict  :: HashMap (Route UniWorX) Value
+  , btfAddAuth   :: Maybe AuthDNF
+  , btfExpiresAt :: Maybe (Maybe UTCTime)
+  , btfStartsAt  :: Maybe UTCTime
+  }
+
+bearerTokenForm :: WForm Handler (FormResult BearerTokenForm)
+bearerTokenForm = do
+  muid <- maybeAuthId
+  
+  btfAuthorityGroups <- aFormToWForm $ HashSet.fromList . map Left <$> massInputListA pathPieceField (const "") (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-groups" :: Text) (fslI MsgBearerTokenAuthorityGroups & setTooltip MsgBearerTokenAuthorityGroupsTip) False Nothing
+  btfAuthorityUsers <- fmap (fmap . ofoldMap $ HashSet.singleton . Right) <$> wopt (checkMap (foldMapM $ fmap Set.singleton . left MsgBearerTokenAuthorityUnknownUser) (Set.map Right) $ multiUserField False Nothing) (fslI MsgBearerTokenAuthorityUsers & setTooltip MsgBearerTokenAuthorityUsersTip) (Just $ Set.singleton <$> muid)
+  let btfAuthority' :: FormResult (HashSet (Either UserGroupName UserId))
+      btfAuthority'
+        = (<>) <$> btfAuthorityGroups <*> ((hoistMaybe =<< btfAuthorityUsers) <|> pure HashSet.empty)
+
+  let btfRoutesForm = HashSet.fromList <$> massInputListA routeField (const "") (\p -> Just . SomeRoute $ AdminTokensR :#: p) ("token-routes" :: Text) (fslI MsgBearerTokenRoutes & setTooltip MsgBearerTokenRoutesTip) True Nothing
+  btfRoutes' <- optionalActionW btfRoutesForm (fslI MsgBearerTokenRestrictRoutes) (Just True)
+
+  let btfRestrictForm = massInputAccumEditW miAdd' miCell' (\p -> Just . SomeRoute $ AdminTokensR :#: p) miLayout' ("token-restrictions" :: Text) (fslI MsgBearerTokenRestrictions) False Nothing
+        where miAdd' nudge = fmap (over (mapped . _1) tweakRes) . miForm nudge . Left
+                where tweakRes res = res <&> \(newRoute, newRestr) oldRestrs -> pure (bool [(newRoute, newRestr)] [] $ newRoute `HashMap.member` HashMap.fromList oldRestrs)
+              miCell' nudge = miForm nudge . Right
+              miForm :: (Text -> Text)
+                     -> Either (FieldView UniWorX) (Route UniWorX, Value)
+                     -> Form (Route UniWorX, Value)
+              miForm nudge mode csrf = do
+                (routeRes, routeView) <- mpreq routeField ("" & addName (nudge "route")) (mode ^? _Right . _1)
+                (restrRes, restrView) <- mpreq (checkMap (left Text.pack . Aeson.eitherDecode . encodeUtf8 . fromStrict . unTextarea) (Textarea . toStrict . decodeUtf8 . Aeson.encodePretty) textareaField) ("" & addName (nudge "restr")) (mode ^? _Right . _2)
+
+                return ((,) <$> routeRes <*> restrRes, case mode of
+                           Left btn -> $(widgetFile "widgets/massinput/token-restrictions/add")
+                           Right _  -> $(widgetFile "widgets/massinput/token-restrictions/cell")
+                       )
+
+              miLayout' :: MassInputLayout ListLength (Route UniWorX, Value) (Route UniWorX, Value)
+              miLayout' lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/token-restrictions/layout")
+                
+  btfRestrict' <- fmap HashMap.fromList <$> btfRestrictForm
+
+  btfAddAuth' <- fmap (assertM $ not . Set.null . dnfTerms) <$> wopt pathPieceField (fslI MsgBearerTokenAdditionalAuth & setTooltip MsgBearerTokenAdditionalAuthTip) Nothing
+
+  btfExpiresAt' <- optionalActionW (aopt utcTimeField (fslI MsgBearerTokenExpires & setTooltip MsgBearerTokenExpiresTip) Nothing) (fslI MsgBearerTokenOverrideExpiration) (Just False)
+  btfStartsAt' <- wopt utcTimeField (fslI MsgBearerTokenOverrideStart & setTooltip MsgBearerTokenOverrideStartTip) Nothing
+
+  return $ BearerTokenForm
+    <$> btfAuthority'
+    <*> btfRoutes'
+    <*> btfRestrict'
+    <*> btfAddAuth'
+    <*> btfExpiresAt'
+    <*> btfStartsAt'
+
+
+getAdminTokensR, postAdminTokensR :: Handler Html
+getAdminTokensR = postAdminTokensR
+postAdminTokensR = do
+  ((bearerReq, bearerView), bearerEnc) <- runFormPost $ renderWForm FormStandard bearerTokenForm
+
+  mjwt <- formResultMaybe bearerReq $ \BearerTokenForm{..} -> do
+    uid <- requireAuthId
+    let btfAuthority' = btfAuthority
+          & HashSet.insert (Right uid)
+          & HashSet.map (left toJSON)
+
+    fmap Just . encodeBearer . set _bearerRestrictions btfRestrict =<< bearerToken btfAuthority' btfRoutes btfAddAuth btfExpiresAt btfStartsAt
+    
+  siteLayoutMsg' MsgMenuAdminTokens $ do
+    setTitleI MsgMenuAdminTokens
+
+    let bearerForm = wrapForm bearerView def
+          { formMethod = POST
+          , formAction = Just $ SomeRoute AdminTokensR
+          , formEncoding = bearerEnc
+          }
+
+    warning <- notification NotificationBroad <$> messageI Warning MsgBearerTokenUsageWarning
+
+    $(widgetFile "admin-tokens")

src/Handler/Allocation.hs

@@ -9,3 +9,5 @@ import Handler.Allocation.Register as Handler.Allocation
 import Handler.Allocation.List as Handler.Allocation
 import Handler.Allocation.Users as Handler.Allocation
 import Handler.Allocation.Prios as Handler.Allocation
+import Handler.Allocation.Compute as Handler.Allocation
+import Handler.Allocation.Accept as Handler.Allocation

src/Handler/Allocation/Accept.hs

@@ -0,0 +1,162 @@
+module Handler.Allocation.Accept
+  ( SessionDataAllocationResults(..)
+  , AllocationAcceptButton(..)
+  , allocationAcceptForm
+  , getAAcceptR, postAAcceptR
+  ) where
+
+import Import
+import Handler.Utils
+import Handler.Utils.Allocation
+
+import Data.Map ((!?))
+import qualified Data.Map as Map
+
+import qualified Database.Esqueleto as E
+import qualified Control.Monad.State.Class as State
+
+import Data.Sequence (Seq((:|>)))
+
+
+newtype SessionDataAllocationResults = SessionDataAllocationResults
+  { getSessionDataAllocationResults :: Map ( TermId
+                                           , SchoolId
+                                           , AllocationShorthand
+                                           )
+                                           ( UTCTime
+                                           , AllocationFingerprint
+                                           , Set (UserId, CourseId)
+                                           , Seq MatchingLogRun
+                                           )
+  } deriving (Eq, Ord, Read, Show, Generic, Typeable)
+    deriving newtype (ToJSON, FromJSON)
+    deriving (Monoid, Semigroup) via Dual (Map (TermId, SchoolId, AllocationShorthand) (UTCTime, AllocationFingerprint, Set (UserId, CourseId), Seq MatchingLogRun))
+
+makeWrapped ''SessionDataAllocationResults
+  
+
+data AllocationAcceptButton
+  = BtnAllocationAccept
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+
+nullaryPathPiece ''AllocationAcceptButton $ camelToPathPiece' 2
+embedRenderMessage ''UniWorX ''AllocationAcceptButton id
+
+instance Button UniWorX AllocationAcceptButton where
+  btnClasses BtnAllocationAccept = [BCIsButton, BCPrimary]
+
+
+allocationAcceptForm :: AllocationId -> DB (Maybe (Form (UTCTime, AllocationFingerprint, Set (UserId, CourseId), Seq MatchingLogRun)))
+allocationAcceptForm aId = runMaybeT $ do
+  Allocation{..} <- MaybeT $ get aId
+  SessionDataAllocationResults allocMap <- MaybeT $ lookupSessionJson SessionAllocationResults
+  allocRes@(allocTime, allocFp, allocMatching, _ :|> MatchingLogRun{..}) <- hoistMaybe $ allocMap !? (allocationTerm, allocationSchool, allocationShorthand)
+
+  allocationUsers <- fmap (map $ bimap E.unValue E.unValue) . lift . E.select . E.from $ \allocationUser -> do
+    E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
+         E.&&. E.not_ (E.isNothing $ allocationUser E.^. AllocationUserPriority)
+    let applications = E.subSelectCount . E.from $ \courseApplication ->
+          E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.val (Just aId)
+               E.&&. courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
+    return . (allocationUser E.^. AllocationUserUser, ) $ E.case_ 
+      [ E.when_ (E.castNum (allocationUser E.^. AllocationUserTotalCourses) E.>. applications)
+        E.then_ (applications :: E.SqlExpr (E.Value Int))
+      ]
+      (E.else_ . E.castNum $ allocationUser E.^. AllocationUserTotalCourses)
+  let allocationPlacesRequested = sumOf (folded . _2) allocationUsers
+      userAllocations = ofoldr (\(uid, _cid) -> Map.insertWith (+) uid 1) Map.empty allocMatching
+
+  allocationUsers' <- hoistMaybe $
+    let (res, leftoverAllocs) = foldr (\user@(uid, _) (acc, allocCounts)
+                                       -> ( (user, Map.findWithDefault 0 uid allocCounts) : acc
+                                          , Map.delete uid allocCounts
+                                          ))
+                                ([] , userAllocations) allocationUsers
+     in guardOn (null leftoverAllocs) res :: Maybe [((UserId, Int), Integer)]
+
+  let unmatchedUsers = olength $ filter ((<= 0) . view _2) allocationUsers'
+
+  allocationCourses <- fmap (map $ over _3 E.unValue) . lift . E.select . E.from $ \(allocationCourse `E.InnerJoin` course) -> do
+    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+     E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+    let participants = E.subSelectCount . E.from $ \courseParticipant ->
+          E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+               E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+    return (allocationCourse, course, participants)
+  let allocationCapacity = sumOf (folded . _2 . _entityVal . _courseCapacity . _Just) allocationCourses
+
+  let courseAllocations = ofoldr (\(_uid, cid) -> Map.insertWith (+) cid 1) Map.empty allocMatching
+  allocationCourses' <- hoistMaybe $
+    let (res, leftoverAllocs) = foldr (\course@(_, Entity cid _, _) (acc, allocCounts)
+                                       -> ( (course, Map.findWithDefault 0 cid allocCounts) : acc
+                                          , Map.delete cid allocCounts
+                                          ))
+                                ([] , courseAllocations) allocationCourses
+     in guardOn (null leftoverAllocs) res :: Maybe [((Entity AllocationCourse, Entity Course, Int), Int)]
+
+  let unmatchedCourses = olength $ filter ((<= 0) . view _2) allocationCourses'
+
+  let validateMatches =
+        guardValidation MsgAllocationAcceptFormDoesNotMatchSession =<< State.get
+
+  return . set (mapped . mapped . _1 . mapped) allocRes . validateForm validateMatches . identifyForm FIDAllocationAccept $ \csrf -> do
+    (prevAllocRes, prevAllocView) <- mreq hiddenField "" $ Just allocFp
+    let prevAllocMatches = (== allocFp) <$> prevAllocRes
+
+    let
+      showTerms
+        | [_] <- nubOn (view $ _1 . _2 . _entityVal . _courseTerm) allocationCourses'
+        = False
+        | otherwise
+        = True
+      showSchools
+        | [_] <- nubOn (view $ _1 . _2 . _entityVal . _courseSchool) allocationCourses'
+        = False
+        | otherwise
+        = True
+      optimumAllocated = round . (* optimumProportion) . fromIntegral
+        where optimumProportion :: Rational
+              optimumProportion
+                | allocationCapacity == 0 = 0
+                | otherwise = fromIntegral allocationPlacesRequested % fromIntegral allocationCapacity
+      allocHeat capN
+        = invDualHeat (optimumAllocated capN) capN
+      degenerateHeat capN
+        = capN <= optimumAllocated capN
+      
+    return (prevAllocMatches, $(widgetFile "allocation/accept"))
+
+getAAcceptR, postAAcceptR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
+getAAcceptR = postAAcceptR
+postAAcceptR tid ssh ash = do
+  (((_, acceptView), acceptEnctype), didStore) <- runDB $ do
+    aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
+
+    acceptForm <- maybe (redirect $ AllocationR tid ssh ash AComputeR) return =<< allocationAcceptForm aId
+
+    formRes@((acceptRes, _), _) <- liftHandler $ runFormPost acceptForm 
+
+    didStore <- formResultMaybe acceptRes $ \(now, allocFp, allocMatchings, allocLog) -> do
+      modifySessionJson SessionAllocationResults . fmap (assertM $ not . views _Wrapped onull) . over (mapped . _Wrapped :: Setter' (Maybe SessionDataAllocationResults) _) $
+        Map.filterWithKey (\(tid', ssh', ash') (_, allocFp', _, _) ->
+                             or [ tid' /= tid
+                                , ssh' /= ssh
+                                , ash' /= ash
+                                , allocFp' /= allocFp
+                                ])
+      storeAllocationResult aId now (allocFp, allocMatchings, allocLog)
+      return $ Just ()
+
+    return (formRes, is _Just didStore)
+
+  when didStore $ do
+    addMessageI Success MsgAllocationAccepted
+    redirect $ AllocationR tid ssh ash AUsersR
+
+  siteLayoutMsg MsgMenuAllocationAccept $ do
+    setTitleI MsgMenuAllocationAccept
+
+    wrapForm' BtnAllocationAccept acceptView def
+      { formEncoding = acceptEnctype
+      }

src/Handler/Allocation/Compute.hs

@@ -0,0 +1,131 @@
+module Handler.Allocation.Compute
+  ( getAComputeR
+  , postAComputeR
+  ) where
+
+import Import
+
+import Handler.Utils
+import Handler.Utils.Allocation
+import Handler.Allocation.Accept (SessionDataAllocationResults(..))
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+
+import qualified Database.Esqueleto as E
+
+import qualified Control.Monad.State.Class as State
+
+
+data AllocationComputeForm = AllocationComputeForm
+  { acfMissingPrioritiesOk :: Set UserId
+  , acfRestrictCourses :: Maybe (Set CourseId)
+  }
+
+data AllocationComputeButton
+  = BtnAllocationCompute
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+
+nullaryPathPiece ''AllocationComputeButton $ camelToPathPiece' 2
+embedRenderMessage ''UniWorX ''AllocationComputeButton id
+
+instance Button UniWorX AllocationComputeButton where
+  btnClasses BtnAllocationCompute = [BCIsButton, BCPrimary]
+
+missingPrioritiesUsers :: AllocationId -> DB (Map UserId User)
+missingPrioritiesUsers aId = $cachedHereBinary aId $ do
+  usersWithoutPrio <- E.select . E.from $ \(user `E.InnerJoin` allocationUser) -> do
+    E.on $ user E.^. UserId E.==. allocationUser E.^. AllocationUserUser
+     E.&&. allocationUser E.^. AllocationUserAllocation E.==. E.val aId
+
+    -- Ignore users without applications
+    E.where_ . E.exists . E.from $ \courseApplication -> do
+      E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.just (E.val aId)
+           E.&&. courseApplication E.^. CourseApplicationUser E.==. user E.^. UserId
+      E.where_ . E.exists . E.from $ \allocationCourse ->
+        E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
+             E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+
+    E.where_ . E.isNothing $ allocationUser E.^. AllocationUserPriority
+
+    return user
+
+  return $ toMapOf (folded .> _entityVal) usersWithoutPrio
+
+missingPriorities :: AllocationId -> AForm DB (Set UserId)
+missingPriorities aId = wFormToAForm $ do
+  usersWithoutPrio <- lift . lift $ missingPrioritiesUsers aId
+
+  let missingPriosField = checkBoxField { fieldView = missingPriosFieldView }
+        where
+          missingPriosFieldView theId name attrs res isReq
+            = $(i18nWidgetFile "allocation-confirm-missing-prios")
+            where checkBoxFieldView = labeledCheckBoxView (i18n MsgAllocationUsersMissingPrioritiesOk) theId name attrs res isReq
+          
+  if
+    | null usersWithoutPrio
+      -> return $ pure Set.empty
+    | otherwise
+      -> fmap (bool Set.empty $ Map.keysSet usersWithoutPrio) <$> wpreq missingPriosField (fslI MsgAllocationUsersMissingPriorities & setTooltip MsgAllocationUsersMissingPrioritiesTip) (Just False)
+
+
+restrictCourses :: (MonadHandler m, HandlerSite m ~ UniWorX) => AllocationId -> AForm m (Maybe (Set CourseId))
+restrictCourses aId = hoistAForm liftHandler $
+  optionalActionA selectCourses (fslI MsgAllocationRestrictCourses & setTooltip MsgAllocationRestrictCoursesTip) (Just False)
+  where
+    selectCourses = courseSelectForm query coursePred miButtonAction' miIdent' fSettings fRequired mPrev
+      where
+        query = E.from $ \(course `E.InnerJoin` allocationCourse) -> do
+          E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
+           E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+          return course
+        coursePred _ = return True
+        mPrev = Nothing
+        fRequired = True
+        fSettings = fslI MsgAllocationRestrictCoursesSelection & setTooltip MsgAllocationRestrictCoursesSelectionTip
+        miIdent' :: Text
+        miIdent' = "course-selection"
+        miButtonAction' _ = Nothing
+
+allocationComputeForm :: AllocationId -> AForm DB AllocationComputeForm
+allocationComputeForm aId = wFormToAForm $ do
+  onlyComputeMsg <- messageI Info MsgAllocationOnlyCompute
+
+  aFormToWForm $ AllocationComputeForm
+    <$  aformMessage onlyComputeMsg
+    <*> missingPriorities aId
+    <*> restrictCourses aId
+
+validateAllocationComputeForm :: AllocationId -> FormValidator AllocationComputeForm DB ()
+validateAllocationComputeForm aId = do
+  usersWithoutPrio <- lift $ missingPrioritiesUsers aId
+
+  missingOk <- State.gets acfMissingPrioritiesOk
+  guardValidation MsgAllocationUsersMissingPrioritiesNotOk $
+    Map.keysSet usersWithoutPrio `Set.isSubsetOf` missingOk
+
+
+getAComputeR, postAComputeR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
+getAComputeR = postAComputeR
+postAComputeR tid ssh ash = do
+  (_, ((_computeFormRes, computeFormView), computeFormEnctype)) <- runDB $ do
+    aEnt@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
+    formRes@((computeFormRes, _), _) <- runFormPost . validateForm (validateAllocationComputeForm aId) . renderAForm FormStandard $ allocationComputeForm aId
+
+    formResult computeFormRes $ \AllocationComputeForm{..} -> do
+      now <- liftIO getCurrentTime
+      (allocFp, allocMatching, allocLog) <- computeAllocation aEnt acfRestrictCourses
+      tellSessionJson SessionAllocationResults . SessionDataAllocationResults $
+        Map.singleton (tid, ssh, ash) (now, allocFp, allocMatching, allocLog)
+      addMessageI Success MsgAllocationComputed
+      redirect $ AllocationR tid ssh ash AUsersR -- Redirect aborts transaction for safety
+
+    return (aEnt, formRes)
+
+  siteLayoutMsg MsgMenuAllocationCompute $ do
+    setTitleI MsgMenuAllocationCompute
+
+    wrapForm' BtnAllocationCompute computeFormView def
+      { formEncoding = computeFormEnctype
+      }

src/Handler/Allocation/List.hs

@@ -69,7 +69,7 @@ getAllocationListR = do
                     <*> view queryAvailable
                     <*> view (maybe (to . const $ E.val 0) queryApplied muid)
 
-    dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) AllocationTableData
+    dbtProj :: DBRow _ -> DB AllocationTableData
     dbtProj = return . over (_dbrOutput . _2) E.unValue . over (_dbrOutput . _3) E.unValue
 
     dbtRowKey = view $ queryAllocation . to (E.^. AllocationId)

src/Handler/Allocation/Prios.hs

@@ -57,8 +57,8 @@ postAPriosR tid ssh ash = do
 
   formResult priosRes $ \(mode, fInfo) -> do
     let sourcePrios = case mode of
-          AllocationPrioritiesNumeric -> fileSourceCsvPositional Csv.NoHeader fInfo
+          AllocationPrioritiesNumeric -> transPipe liftHandler fInfo .| fileSourceCsvPositional Csv.NoHeader
-          AllocationPrioritiesOrdinal -> fileSourceCsvPositional Csv.NoHeader fInfo .| C.map Csv.fromOnly .| ordinalPriorities
+          AllocationPrioritiesOrdinal -> transPipe liftHandler fInfo .| fileSourceCsvPositional Csv.NoHeader .| C.map Csv.fromOnly .| ordinalPriorities
     
     (matrSunk, matrMissing) <- runDB $ do
       Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
@@ -66,7 +66,15 @@ postAPriosR tid ssh ash = do
         [ AllocationUserAllocation ==. aId ]
         [ AllocationUserPriority =. Nothing ]
       matrSunk <- runConduit $ sourcePrios .| sinkAllocationPriorities aId
-      matrMissing <- fromIntegral <$> count [ AllocationUserAllocation ==. aId, AllocationUserPriority ==. Nothing ]
+      matrMissing <- E.selectCountRows . E.from $ \allocationUser -> do
+        E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId
+             E.&&. E.isNothing (allocationUser E.^. AllocationUserPriority)
+
+        E.where_ . E.exists . E.from $ \(courseApplication `E.InnerJoin` allocationCourse) -> do
+          E.on $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
+           E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
+          E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
+               E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (E.val aId)
       return (matrSunk, matrMissing)
 
     when (matrSunk > 0) $ 

src/Handler/Allocation/Show.hs

@@ -33,6 +33,7 @@ getAShowR tid ssh ash = do
     courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication `E.LeftOuterJoin` registration) -> do
       E.on $ registration E.?. CourseParticipantCourse E.==. E.just (course E.^. CourseId)
        E.&&. registration E.?. CourseParticipantUser E.==. E.val muid
+       E.&&. registration E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
       E.on $ courseApplication E.?. CourseApplicationCourse E.==. E.just (course E.^. CourseId)
        E.&&. courseApplication E.?. CourseApplicationUser E.==. E.val muid
        E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)

src/Handler/Allocation/Users.hs

@@ -6,6 +6,8 @@ module Handler.Allocation.Users
 
 import Import
 
+import Handler.Allocation.Accept
+
 import Handler.Utils
 import Handler.Utils.Allocation
 
@@ -14,6 +16,12 @@ import qualified Database.Esqueleto.Utils as E
 
 import qualified Data.Csv as Csv
 
+import Data.Map ((!?))
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import Text.Blaze (toMarkup)
+
 
 type UserTableExpr = E.SqlExpr (Entity User)
        `E.InnerJoin` E.SqlExpr (Entity AllocationUser)
@@ -26,7 +34,9 @@ queryAllocationUser = to $(E.sqlIJproj 2 2)
 
 queryAppliedCourses :: Getter UserTableExpr (E.SqlExpr (E.Value Int))
 queryAppliedCourses = queryAllocationUser . to queryAppliedCourses'
-  where queryAppliedCourses' allocationUser = E.subSelectCount . E.from $ \courseApplication ->
+  where queryAppliedCourses' allocationUser = E.subSelectCount . E.from $ \(courseApplication `E.InnerJoin` allocationCourse) -> do
+          E.on $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
+           E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
           E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
                E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationUser E.^. AllocationUserAllocation)
 
@@ -35,10 +45,13 @@ queryAssignedCourses = queryAllocationUser . to queryAssignedCourses'
   where queryAssignedCourses' allocationUser = E.subSelectCount . E.from $ \courseParticipant ->
           E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. allocationUser E.^. AllocationUserUser
                E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.just (allocationUser E.^. AllocationUserAllocation)
+               E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
 
 queryVetoedCourses :: Getter UserTableExpr (E.SqlExpr (E.Value Int))
 queryVetoedCourses = queryAllocationUser . to queryVetoedCourses'
-  where queryVetoedCourses' allocationUser = E.subSelectCount . E.from $ \courseApplication -> do
+  where queryVetoedCourses' allocationUser = E.subSelectCount . E.from $ \(courseApplication `E.InnerJoin` allocationCourse) -> do
+          E.on $ allocationCourse E.^. AllocationCourseCourse E.==. courseApplication E.^. CourseApplicationCourse
+           E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationCourse E.^. AllocationCourseAllocation)
           E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser
                E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationUser E.^. AllocationUserAllocation)
           E.where_ $ courseApplication E.^. CourseApplicationRatingVeto
@@ -103,10 +116,13 @@ instance CsvColumnsExplained AllocationUserTableCsv where
 getAUsersR, postAUsersR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
 getAUsersR = postAUsersR
 postAUsersR tid ssh ash = do
-  usersTable <- runDB $ do
+  (usersTable, acceptForm) <- runDB $ do
     Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash
-    now <- liftIO getCurrentTime
+    resultsDone <- is _Just <$> allocationStarted aId
-    resultsDone <- (<= NTop (Just now)) . NTop <$> allocationDone aId
+    allocMatching <- runMaybeT $ do
+      SessionDataAllocationResults allocMap <- MaybeT $ lookupSessionJson SessionAllocationResults
+      allocMatching <- fmap (view _3) . hoistMaybe $ allocMap !? (tid, ssh, ash)
+      return $ Map.fromListWith (<>) [ (uid, opoint cid) | (uid, cid) <- Set.toList allocMatching ] :: _ (Map UserId (NonNull (Set CourseId)))
 
     csvName <- getMessageRender <*> pure (MsgAllocationUsersCsvName tid ssh ash)
 
@@ -136,48 +152,75 @@ postAUsersR tid ssh ash = do
             (,,,,)
               <$> view _1 <*> view _2 <*> view (_3 . _Value) <*> view (_4 . _Value) <*> view (_5 . _Value)
           dbtColonnade :: Colonnade Sortable _ _
-          dbtColonnade = mconcat
+          dbtColonnade = mconcat . catMaybes $
-            [ colUserDisplayName $ resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname
+            [ pure $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
-            , colUserMatriculation $ resultUser . _entityVal . _userMatrikelnummer
+            , pure $ colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
-            , colAllocationRequested $ resultAllocationUser . _entityVal . _allocationUserTotalCourses
+            , pure $ colAllocationRequested (resultAllocationUser . _entityVal . _allocationUserTotalCourses)
-            , coursesModalApplied $ colAllocationApplied resultAppliedCourses
+            , pure . coursesModalApplied $ colAllocationApplied resultAppliedCourses
-            , coursesModalVetoed $ colAllocationVetoed resultVetoedCourses
+            , pure . coursesModalVetoed $ colAllocationVetoed resultVetoedCourses
-            , coursesModalAssigned . assignedHeated $ colAllocationAssigned resultAssignedCourses
+            , guardOn resultsDone . coursesModalAssigned . bool id (assignedHeated $ view resultAssignedCourses) resultsDone $ colAllocationAssigned resultAssignedCourses
-            , emptyOpticColonnade' emptyPriorityCell (resultAllocationUser . _entityVal . _allocationUserPriority . _Just) colAllocationPriority
+            , coursesModalNewAssigned <$> do
+                allocMatching' <- allocMatching
+                let newAssigned uid = maybe 0 olength $ allocMatching' !? uid
+                pure . assignedHeated (views (resultUser . _entityKey) newAssigned) . sortable (Just "new-assigned") (i18nCell MsgAllocationUserNewMatches) .
+                  views (resultUser . _entityKey) $ cell . toWidget . toMarkup . newAssigned
+            , pure $ emptyOpticColonnade' emptyPriorityCell (resultAllocationUser . _entityVal . _allocationUserPriority . _Just) colAllocationPriority
             ]
             where
               emptyPriorityCell = addCellClass ("table__td--center" :: Text) . cell $
                 messageTooltip =<< messageIconI Error IconMissingAllocationPriority MsgAllocationMissingPrioritiesIgnored
-              assignedHeated
+              assignedHeated fAssigned = imapColonnade assignedHeated'
-                | resultsDone = imapColonnade assignedHeated'
-                | otherwise   = id
                 where
                   assignedHeated' res
                     = let maxAssign = min (res ^. resultAllocationUser . _entityVal . _allocationUserTotalCourses . to fromIntegral)
                                           (res ^. resultAppliedCourses)
-                          assigned = maxAssign - res ^. resultAssignedCourses
+                          assigned = fAssigned res
                        in cellAttrs <>~ [ ("class", "heated")
-                                        , ("style", [st|--hotness: #{tshow (heat maxAssign assigned)}|])
+                                        , ("style", [st|--hotness: #{tshow (coHeat maxAssign assigned)}|])
                                         ]
               coursesModalApplied = coursesModal $ \res -> E.from $ \(course `E.InnerJoin` courseApplication) -> do
                 E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
                 E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.val (Just aId)
                      E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val (res ^. resultUser . _entityKey)
                 E.orderBy [E.desc $ courseApplication E.^. CourseApplicationAllocationPriority]
-                return course
+                return ( course
+                       , courseApplication E.^. CourseApplicationRatingPoints
+                       , E.just $ courseApplication E.^. CourseApplicationRatingVeto
+                       , E.exists . E.from $ \allocationCourse ->
+                           E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+                                E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+                       )
               coursesModalVetoed = coursesModal $ \res -> E.from $ \(course `E.InnerJoin` courseApplication) -> do
                 E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
                 E.where_ $ courseApplication E.^. CourseApplicationAllocation E.==. E.val (Just aId)
                      E.&&. courseApplication E.^. CourseApplicationUser E.==. E.val (res ^. resultUser . _entityKey)
                 E.where_ $ courseApplication E.^. CourseApplicationRatingVeto
                      E.||. courseApplication E.^. CourseApplicationRatingPoints `E.in_` E.valList (map Just $ filter (view $ passingGrade . _Wrapped . to not) universeF)
-                return course
+                return ( course
+                       , E.nothing
+                       , E.nothing
+                       , E.exists . E.from $ \allocationCourse ->
+                           E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+                                E.&&. allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+                       )
               coursesModalAssigned = coursesModal $ \res -> E.from $ \(course `E.InnerJoin` courseParticipant) -> do
                 E.on $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
                  E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.val (Just aId)
                 E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val (res ^. resultUser . _entityKey)
                 E.orderBy [E.asc $ courseParticipant E.^. CourseParticipantRegistration]
-                return course
+                return ( course
+                       , E.nothing
+                       , E.nothing
+                       , courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+                       )
+              coursesModalNewAssigned = coursesModal $ \res -> E.from $ \course -> do
+                E.where_ $ course E.^. CourseId `E.in_` E.valList (maybe [] otoList $ Map.lookup (res ^. resultUser . _entityKey) =<< allocMatching)
+                return ( course
+                       , E.nothing
+                       , E.nothing
+                       , E.true
+                       )
+              coursesModal :: (_ -> E.SqlQuery (E.SqlExpr (Entity Course), E.SqlExpr (E.Value (Maybe ExamGrade)), E.SqlExpr (E.Value (Maybe Bool)), E.SqlExpr (E.Value Bool))) -> _ -> _
               coursesModal courseSel = imapColonnade coursesModal'
                 where
                   coursesModal' res innerCell = review dbCell . (innerCell ^. cellAttrs, ) $ do
@@ -185,19 +228,22 @@ postAUsersR tid ssh ash = do
                     contents <- innerCell ^. cellContents
                     return $ if
                       | null courses -> contents
-                      | otherwise    -> $(widgetFile "table/cell/allocation-courses")
+                      | otherwise    -> let tooltipContent = $(widgetFile "table/cell/allocation-courses")
+                                          in $(widgetFile "widgets/tooltip_no-handle")
           dbtSorting = mconcat
             [ sortUserName' $ queryUser . $(multifocusG 2) (to (E.^. UserDisplayName)) (to (E.^. UserSurname))
-            , sortUserMatriculation $ queryUser . (to (E.^. UserMatrikelnummer))
+            , sortUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
             , sortAllocationApplied queryAppliedCourses
             , sortAllocationAssigned queryAssignedCourses
-            , sortAllocationRequested $ queryAllocationUser . (to (E.^. AllocationUserTotalCourses))
+            , sortAllocationRequested $ queryAllocationUser . to (E.^. AllocationUserTotalCourses)
             , sortAllocationVetoed queryVetoedCourses
-            , sortAllocationPriority $ queryAllocationUser . (to (E.^. AllocationUserPriority))
+            , sortAllocationPriority $ queryAllocationUser . to (E.^. AllocationUserPriority)
+            , singletonMap "new-assigned" $
+                SortProjected . comparing $ (\uid -> maybe 0 olength $ Map.lookup uid =<< allocMatching) . view (resultUser . _entityKey)
             ]
           dbtFilter = mconcat
-            [ fltrUserName' $ queryUser . (to (E.^. UserDisplayName))
+            [ fltrUserName' $ queryUser . to (E.^. UserDisplayName)
-            , fltrUserMatriculation $ queryUser . (to (E.^. UserMatrikelnummer))
+            , fltrUserMatriculation $ queryUser . to (E.^. UserMatrikelnummer)
             ]
           dbtFilterUI = mconcat
             [ fltrUserNameUI'
@@ -220,12 +266,22 @@ postAUsersR tid ssh ash = do
           dbtCsvDecode = Nothing
       allocationUsersDBTableValidator = def
         & defaultSorting [SortAscBy "priority", SortAscBy "user-matriculation"]
-        & defaultPagesize PagesizeAll
+        & defaultPagesize (PagesizeLimit 500)
 
     usersTable <- dbTableDB' allocationUsersDBTableValidator allocationUsersDBTable
-    return usersTable
+
+    acceptForm <- allocationAcceptForm aId
+
+    return (usersTable, acceptForm)
+
+  acceptView <- for acceptForm $ \acceptForm' -> do
+    (acceptWgt, acceptEnctype) <- generateFormPost acceptForm'
+    return $ wrapForm' BtnAllocationAccept acceptWgt def
+      { formAction = Just . SomeRoute $ AllocationR tid ssh ash AAcceptR
+      , formEncoding = acceptEnctype
+      }
 
   siteLayoutMsg MsgMenuAllocationUsers $ do
     setTitleI $ MsgAllocationUsersTitle tid ssh ash
 
-    usersTable
+    $(widgetFile "allocation/users")

src/Handler/Corrections.hs

@@ -1,4 +1,19 @@
-module Handler.Corrections where
+module Handler.Corrections
+  ( getCorrectionsR, postCorrectionsR
+  , getCCorrectionsR, postCCorrectionsR
+  , getSSubsR, postSSubsR
+  , getCorrectionR, postCorrectionR
+  , getCorrectionsUploadR, postCorrectionsUploadR
+  , getCorrectionsCreateR, postCorrectionsCreateR
+  , getCorrectionsGradeR, postCorrectionsGradeR
+  , getCAssignR, postCAssignR
+  , getSAssignR, postSAssignR
+  , correctionsR'
+  , ratedBy, courseIs, sheetIs, userIs
+  , colTerm, colSchool, colCourse, colSheet, colCorrector, colSubmissionLink, colSelect, colSubmittors, colSMatrikel, colRating, colAssigned, colRated, colPseudonyms, colRatedField, colPointsField, colMaxPointsField, colCommentField, colLastEdit
+  , makeCorrectionsTable
+  , ActionCorrections(..), downloadAction, deleteAction, assignAction, autoAssignAction
+  ) where
 
 import Import hiding (link)
 -- import System.FilePath (takeFileName)
@@ -52,7 +67,7 @@ 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))
 type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool)
-type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym))
+type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym, Maybe SubmissionGroupName), CryptoFileNameSubmission, Bool {- Access to non-anonymous submission data -})
 
 correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
 correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
@@ -71,9 +86,6 @@ lastEditQuery submission = E.subSelectMaybe $ E.from $ \edit -> do
 queryCourse :: CorrectionTableExpr -> E.SqlExpr (Entity Course)
 queryCourse = $(sqlIJproj 3 1) . $(sqlLOJproj 2 1)
 
-querySheet :: CorrectionTableExpr -> E.SqlExpr (Entity Sheet)
-querySheet = $(sqlIJproj 3 2) . $(sqlLOJproj 2 1)
-
 querySubmission :: CorrectionTableExpr -> E.SqlExpr (Entity Submission)
 querySubmission = $(sqlIJproj 3 3) . $(sqlLOJproj 2 1)
 
@@ -90,6 +102,12 @@ courseIs cid  (( course `E.InnerJoin` _sheet `E.InnerJoin` _submission) `E.LeftO
 sheetIs :: Key Sheet -> CorrectionTableWhere
 sheetIs shid  ((_course `E.InnerJoin`  sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = sheet E.^. SheetId E.==. E.val shid
 
+userIs :: Key User -> CorrectionTableWhere
+userIs uid ((_course `E.InnerJoin`  _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = E.exists . E.from $ \submissionUser ->
+  E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+       E.&&. submissionUser E.^. SubmissionUserUser E.==. E.val uid
+
+
 
 -- Columns
 colTerm :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
@@ -104,7 +122,7 @@ colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
 
 colCourse :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colCourse = sortable (Just "course") (i18nCell MsgCourse)
-        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _) } -> courseCellCL (tid,sid,csh)
+        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _, _, _) } -> courseCellCL (tid,sid,csh)
 
 colSheet :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row ->
@@ -116,51 +134,54 @@ colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row ->
               shn   = sheetName $ entityVal sheet
           in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|_{shn}|]
 
-colSheetType :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType) $
-        i18nCell . sheetType <$> view (_dbrOutput . _2 . _entityVal)
-        -- \DBRow{ dbrOutput=(_, sheet, _, _, _, _) } -> i18nCell . sheetType $ entityVal sheet
-
 colCorrector :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
-  DBRow{ dbrOutput = (_, _, _, Nothing  , _, _) } -> cell mempty
+  DBRow{ dbrOutput = (_, _, _, Nothing  , _, _, _, _) } -> cell mempty
-  DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _) } -> userCell userDisplayName userSurname
+  DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _, _, _) } -> userCell userDisplayName userSurname
 
 colSubmissionLink :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
+colSubmissionLink = sortable (Just "submission") (i18nCell MsgSubmission)
-        $ \DBRow{ dbrOutput=(submission, sheet, course, _, _,_) } ->
+        $ \DBRow{ dbrOutput=(_, sheet, course, _, _,_, cid, _) } ->
           let csh = course ^. _2
               tid = course ^. _3
               ssh = course ^. _4
               shn = sheetName $ entityVal sheet
-              mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice
+          in anchorCellC $cacheIdentHere (CSubmissionR tid ssh csh shn cid SubShowR) (toPathPiece cid)
-              mkRoute = do
-                cid <- mkCid
-                return $ CSubmissionR tid ssh csh shn cid SubShowR
-          in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{cid}|])
 
 colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary))
-colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> encrypt subId
+colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(_, _, _, _, _, _, cid, _) } -> return cid
 
 colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users) } -> let
+colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, course, _, _, users, _, hasAccess) } ->
-  csh = course ^. _2
+  let
-  tid = course ^. _3
+    csh = course ^. _2
-  ssh = course ^. _4
+    tid = course ^. _3
-  link cid = CourseR tid ssh csh $ CUserR cid
+    ssh = course ^. _4
-  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) ->
+    link cid = CourseR tid ssh csh $ CUserR cid
-    anchorCellM (link <$> encrypt userId) $ case mPseudo of
+    protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo, _)) ->
-      Nothing -> nameWidget userDisplayName userSurname
+      anchorCellCM $cacheIdentHere (link <$> encrypt userId) $ case mPseudo of
-      Just p  -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|]
+        Nothing -> nameWidget userDisplayName userSurname
-  in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+        Just p  -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|]
+  in if | hasAccess -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+        | otherwise -> mempty
 
 colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let
+colSMatrikel = sortable (Just "submittors-matriculation") (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, (_, csh, tid, ssh), _, _, users, _, hasAccess) } ->
-  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (fromMaybe mempty userMatrikelnummer)
+  let protoCell = listCell (Map.toList $ Map.mapMaybe (\x@(User{..}, _, _) -> (x,) <$> assertM (not . null) userMatrikelnummer) users) $ \(userId, ((User{..}, _, _), matr)) -> anchorCellCM $cacheIdentHere (CourseR tid ssh csh . CUserR <$> encrypt userId) matr 
-  in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+  in if | hasAccess -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+        | otherwise -> mempty
+
+colSGroups :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
+colSGroups = sortable (Just "submittors-group") (i18nCell MsgSubmissionGroup) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, _, _, _, users, _, hasAccess) } ->
+  let protoCell = listCell (nubOn (view _2) . Map.toList $ Map.mapMaybe (view _3) users) $ \(_, sGroup) -> cell $ toWidget sGroup
+  in if | hasAccess
+        , is _RegisteredGroups sheetGrouping
+          -> protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
+        | otherwise
+          -> mempty
 
 colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary))
-colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _) } ->
+colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _, _, _) } ->
   let csh = course ^. _2
       tid = course ^. _3
       ssh = course ^. _4
@@ -171,7 +192,7 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E
         return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
       mTuple mA mB = (,) <$> mA <*> mB -- Hamlet does not support enough haskell-syntax for this
   in mconcat
-     [ anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
+     [ anchorCellCM $cacheIdentHere mkRoute $(widgetFile "widgets/rating/rating")
      , writerCell $ do
          let
            summary :: SheetTypeSummary
@@ -180,48 +201,48 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E
      ]
 
 colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } ->
+colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _, _) } ->
   maybe mempty dateTimeCell submissionRatingAssigned
 
 colRated :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } ->
+colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _, _) } ->
   maybe mempty dateTimeCell submissionRatingTime
 
 colPseudonyms :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
-colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let
+colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users, _, _) } -> let
-    lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo ->
+    lCell = listCell (catMaybes $ view (_2 . _2) <$> Map.toList users) $ \pseudo ->
       cell [whamlet|#{review _PseudonymText pseudo}|]
   in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
 
 colRatedField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (Bool, a, b) CorrectionTableData)))
 colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done))
+  (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done))
 
 colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData)))
 colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id
-  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _) } mkUnique -> case sheetType of
+  (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _, _, _) } mkUnique -> case sheetType of
       NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
       _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)
+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)
+  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _, _) } -> return subId)
-  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
+  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))
 
 colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colLastEdit = sortable (Just "last-edit") (i18nCell MsgLastEdit) $
-   \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _) } -> maybe mempty dateTimeCell mbLastEdit
+   \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _, _, _) } -> maybe mempty dateTimeCell mbLastEdit
 
 
 makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
-                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> PSValidator m x -> _ -> DBParams m x -> DB (DBResult m x)
+                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> PSValidator m x -> DBParams m x -> DB (DBResult m x)
-makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' dbtParams = do
+makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams = do
   let dbtSQLQuery :: CorrectionTableExpr -> E.SqlQuery _
       dbtSQLQuery = correctionsTableQuery whereClause
           (\((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) ->
@@ -232,18 +253,27 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
                         )
             in (submission, sheet, crse, corrector, lastEditQuery submission)
           )
-      dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerFor UniWorX)) CorrectionTableData
+      dbtProj :: DBRow _ -> DB CorrectionTableData
-      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector,  E.Value mbLastEdit) -> do
+      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId Sheet{..}), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector,  E.Value mbLastEdit) -> do
-        submittors <- lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
+        submittors <- E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
           E.on $ pseudonym E.?. SheetPseudonymUser E.==. E.just (user E.^. UserId)
            E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
           E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
           E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
           E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
-          return (user, pseudonym E.?. SheetPseudonymPseudonym)
+          let submissionGroup' = E.subSelectMaybe . E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser) -> do
+                E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
+                E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val sheetCourse
+                E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. user E.^. UserId
+                return . E.just $ submissionGroup E.^. SubmissionGroupName
+          return (user, pseudonym E.?. SheetPseudonymPseudonym, submissionGroup')
         let
-          submittorMap = List.foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
+          submittorMap = List.foldr (\(Entity userId user, E.Value pseudo, E.Value sGroup) -> Map.insert userId (user, pseudo, sGroup)) Map.empty submittors
-        dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap)
+        nonAnonymousAccess <- or2M
+          (return $ not sheetAnonymousCorrection)
+          (hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR)
+        cid <- encrypt sId
+        return (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap, cid, nonAnonymousAccess)
   dbTable psValidator DBTable
     { dbtSQLQuery
     , dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) -> submission E.^. SubmissionId
@@ -285,13 +315,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
         )
       , ( "submittors"
-        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) ->
+        , SortProjected . comparing $ \DBRow{ dbrOutput = (_, _, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap ((userSurname &&& userDisplayName) . view _1) $ Map.elems submittors
-            E.subSelectUnsafe . E.from $ \(submissionUser `E.InnerJoin` user) -> do
+        )
-              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
+      , ( "submittors-matriculation"
-              E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+        , SortProjected . comparing $ \DBRow{ dbrOutput = (_, _, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap (view $ _1 . _userMatrikelnummer) $ Map.elems submittors
-              E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
+        )
-              E.limit 1
+      , ( "submittors-group"
-              return (user E.^. UserSurname)
+        , SortProjected . comparing $ \DBRow{ dbrOutput = (_, _, _, _, _, submittors, _, hasAccess) } -> guardOn @Maybe hasAccess . fmap (view _3) $ Map.elems submittors
         )
       , ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done
         , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment
@@ -299,6 +329,9 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
       , ( "last-edit"
         , SortColumn $ \((_course `E.InnerJoin` _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) -> lastEditQuery submission
         )
+      , ( "submission"
+        , SortProjected . comparing $ toPathPiece . view (_dbrOutput . _7)
+        )
       ]
     , dbtFilter    = Map.fromList
       [ ( "term"
@@ -368,6 +401,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
               E.where_ $ (\f -> f user $ Set.singleton needle) $
                 E.mkContainsFilter (E.^. UserMatrikelnummer)
         )
+      , ( "submission-group"
+        , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser) -> do
+              E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup
+              E.where_ $ queryCourse table E.^. CourseId E.==. submissionGroup E.^. SubmissionGroupCourse
+              E.where_ $ (\f -> f submissionGroup $ Set.singleton needle) $
+                E.mkContainsFilter (E.^. SubmissionGroupName)
+        )
       , ( "rating-visible"
         , FilterColumn $  \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
             Nothing   -> E.val True :: E.SqlExpr (E.Value Bool)
@@ -384,6 +424,12 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
             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)
         )
+      , ( "submission"
+        , FilterProjected $ \(DBRow{..} :: CorrectionTableData) (criteria :: Set Text) ->
+            let cid = map CI.mk . unpack . toPathPiece $ dbrOutput ^. _7
+                criteria' = map CI.mk . unpack <$> Set.toList criteria
+             in any (\c -> c `isInfixOf` cid) criteria'
+        )
       ]
     , dbtFilterUI  = fromMaybe mempty dbtFilterUI
     , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
@@ -405,13 +451,21 @@ instance Finite ActionCorrections
 nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1
 embedRenderMessage ''UniWorX ''ActionCorrections id
 
-data ActionCorrectionsData = CorrDownloadData
+data ActionCorrectionsData = CorrDownloadData SubmissionDownloadAnonymous
                            | CorrSetCorrectorData (Maybe UserId)
                            | CorrAutoSetCorrectorData SheetId
                            | CorrDeleteData
 
 correctionsR :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler TypedContent
 correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
+  (table, statistics) <- correctionsR' whereClause displayColumns dbtFilterUI psValidator actions
+
+  fmap toTypedContent . defaultLayout $ do
+    setTitleI MsgCourseCorrectionsTitle
+    $(widgetFile "corrections")
+  
+correctionsR' :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler (Widget, SheetTypeSummary)
+correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
   currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
 
   postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords)
@@ -420,7 +474,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
     }
 
   ((actionRes', statistics), table) <- runDB $
-    makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator return DBParamsForm
+    makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator DBParamsForm
       { dbParamsFormMethod = POST
       , dbParamsFormAction = Just $ SomeRoute currentRoute
       , dbParamsFormAttrs = []
@@ -445,14 +499,12 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
                              & mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast
       auditAllSubEdit = mapM_ $ \sId -> getJust sId >>= \sub -> audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet
 
-  case actionRes of
+  formResult actionRes $ \case
-    FormFailure errs -> mapM_ (addMessage Warning . toHtml) errs
+    (CorrDownloadData nonAnonymous, subs) -> do
-    FormMissing      -> return ()
-    FormSuccess (CorrDownloadData, subs) -> do
       ids <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
       addHeader "Content-Disposition" [st|attachment; filename="corrections.zip"|]
-      sendResponse =<< submissionMultiArchive ids
+      sendResponse =<< submissionMultiArchive nonAnonymous ids
-    FormSuccess (CorrSetCorrectorData (Just uid), subs') -> do
+    (CorrSetCorrectorData (Just uid), subs') -> do
       subs <- mapM decrypt $ Set.toList subs'
       now <- liftIO getCurrentTime
       runDB $ do
@@ -485,7 +537,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
             return (E.countRows :: E.SqlExpr (E.Value Int64))
         when (selfCorrectors > 0) $ addMessageI Warning $ MsgSelfCorrectors selfCorrectors
       redirect currentRoute
-    FormSuccess (CorrSetCorrectorData Nothing, subs') -> do -- delete corrections
+    (CorrSetCorrectorData Nothing, subs') -> do -- delete corrections
       subs <- mapM decrypt $ Set.toList subs'
       runDB $ do
         num <- updateWhereCount [SubmissionId <-. subs]
@@ -498,7 +550,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
         addMessageI Success $ MsgRemovedCorrections num
         auditAllSubEdit subs
       redirect currentRoute
-    FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do
+    (CorrAutoSetCorrectorData shid, subs') -> do
       subs <- mapM decrypt $ Set.toList subs'
       let
         assignExceptions :: AssignSubmissionException -> Handler ()
@@ -535,16 +587,14 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
             unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> encrypt sid :: DB CryptoFileNameSubmission
             addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
       redirect currentRoute
-    FormSuccess (CorrDeleteData, subs) -> do
+    (CorrDeleteData, subs) -> do
       subs' <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
       getDeleteR (submissionDeleteRoute subs')
         { drAbort = SomeRoute currentRoute
         , drSuccess = SomeRoute currentRoute
         }
 
-  fmap toTypedContent . defaultLayout $ do
+  return (table, statistics)
-    setTitleI MsgCourseCorrectionsTitle
-    $(widgetFile "corrections")
 
   where
     authorizedToAssign :: SubmissionId -> DB Bool
@@ -559,11 +609,22 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
       let route  = CSubmissionR tid ssh csh shn cID SubAssignR
       (== Authorized) <$> evalAccessDB route True
 
+restrictAnonymous :: PSValidator m x -> PSValidator m x
+restrictAnonymous = restrictFilter (\k _ -> k /= "user-matriclenumber")
+                  . restrictFilter (\k _ -> k /= "user-name-email")
+                  . restrictFilter (\k _ -> k /= "submission-group")
+                  . restrictSorting (\k _ -> k /= "last-edit")
+
+restrictCorrector :: PSValidator m x -> PSValidator m x
+restrictCorrector = restrictFilter (\k _ -> k /= "corrector")
+                  . restrictFilter (\k _ -> k /= "corrector-name-email")
+                  . restrictSorting (\k _ -> k /= "corrector")
+
 type ActionCorrections' = (ActionCorrections, AForm (HandlerFor UniWorX) ActionCorrectionsData)
 
 downloadAction, deleteAction :: ActionCorrections'
 downloadAction = ( CorrDownload
-                 , pure CorrDownloadData
+                 , CorrDownloadData <$> apopt (selectField optionsFinite) (fslI MsgCorrDownloadAnonymous & setTooltip MsgCorrDownloadAnonymousTip) (Just SubmissionDownloadAnonymous)
                  )
 deleteAction = ( CorrDelete
                , pure CorrDeleteData
@@ -601,11 +662,13 @@ postCorrectionsR = do
   let whereClause = ratedBy uid
       colonnade = mconcat
         [ colSelect
-        , dbRow     -- very useful, since correction statistics are still missing.
         , colSchool
         , colTerm
         , colCourse
         , colSheet
+        , colSMatrikel
+        , colSubmittors
+        , colSGroups
         , colPseudonyms
         , colSubmissionLink
         , colAssigned
@@ -618,6 +681,7 @@ postCorrectionsR = do
         , 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 "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
         ]
       courseOptions = runDB $ do
         courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
@@ -630,8 +694,8 @@ postCorrectionsR = do
         optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
 
       psValidator = def
-        & restrictFilter  (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
+        & restrictCorrector
-        & restrictSorting (\name _ -> name /= "corrector")
+        & restrictAnonymous
         & defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ]
         -- & defaultFilter (Map.fromList [("israted",[toPathPiece False])]) -- DEPENDS ON ISSUE #371 UNCOMMENT THEN
   correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
@@ -645,10 +709,10 @@ postCCorrectionsR tid ssh csh = do
   let whereClause = courseIs cid
       colonnade = mconcat -- should match getSSubsR for consistent UX
         [ colSelect
-        , dbRow
         , colSheet
         , colSMatrikel
         , colSubmittors
+        , colSGroups
         , colSubmissionLink
         , colLastEdit
         , colRating
@@ -664,6 +728,8 @@ postCCorrectionsR tid ssh csh = do
         , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
         , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
         , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
+        , prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
         ]
       psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
   correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
@@ -679,7 +745,6 @@ postSSubsR tid ssh csh shn = do
   let whereClause = sheetIs shid
       colonnade = mconcat -- should match getCCorrectionsR for consistent UX
         [ colSelect
-        , dbRow
         , colSMatrikel
         , colSubmittors
         , colSubmissionLink
@@ -695,6 +760,8 @@ postSSubsR tid ssh csh shn = do
         , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
         , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
         , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
+        , prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
         -- "pseudonym" TODO DB only stores Word24
         ]
       psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
@@ -1025,6 +1092,9 @@ postCorrectionsGradeR = do
         , colTerm
         , colCourse
         , colSheet
+        , colSMatrikel
+        , colSubmittors
+        , colSGroups
         , colPseudonyms
         , colSubmissionLink
         , colRated
@@ -1053,37 +1123,33 @@ postCorrectionsGradeR = 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
+        & restrictAnonymous
+        & restrictCorrector
         & 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)
+      unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
-      dbtProj' i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _, _) = do
-        cID <- encrypt subId
-        void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
-        return i
 
-  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI psValidator dbtProj' $ def
+  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI psValidator $ def
     { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
     }
 
-  case tableRes of
+  formResult tableRes $ \resMap -> do
-    FormMissing -> return ()
+    now <- liftIO getCurrentTime
-    FormFailure errs -> forM_ errs $ addMessage Error . toHtml
+    subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do
-    FormSuccess resMap -> do
+      s@Submission{..} <- get404 subId
-      now <- liftIO getCurrentTime
+      if
-      subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do
+        | submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
-        s@Submission{..} <- get404 subId
+          -> do audit $ TransactionSubmissionEdit subId $ s ^. _submissionSheet
-        if
+                Just subId <$ update subId [ SubmissionRatingPoints =. mPoints
-          | submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
+                                           , SubmissionRatingComment =. mComment
-            -> do audit $ TransactionSubmissionEdit subId $ s ^. _submissionSheet
+                                           , SubmissionRatingBy =. Just uid
-                  Just subId <$ update subId [ SubmissionRatingPoints =. mPoints
+                                           , SubmissionRatingTime =. now <$ guard rated
-                                             , SubmissionRatingComment =. mComment
+                                           ]
-                                             , SubmissionRatingBy =. Just uid
+        | otherwise -> return Nothing
-                                             , SubmissionRatingTime =. now <$ guard rated
+    subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
-                                             ]
+    let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
-          | otherwise -> return Nothing
+        content = Right $(widgetFile "messages/correctionsUploaded")
-      subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
+    unless (null subs') $ addMessageModal Success trigger content
-      let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
+    redirect CorrectionsGradeR
-          content = Right $(widgetFile "messages/correctionsUploaded")
-      unless (null subs') $ addMessageModal Success trigger content
 
   siteLayoutMsg MsgCorrectionsGrade $ do
     setTitleI MsgCorrectionsGrade
@@ -1099,9 +1165,6 @@ embedRenderMessage ''UniWorX ''ButtonSubmissionsAssign id
 instance Button UniWorX ButtonSubmissionsAssign where
   btnClasses BtnSubmissionsAssign = [BCIsButton, BCPrimary]
 
--- | DEPRECATED use CorrectorInfo instead. Gather info about corrector assignment per sheet
-data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiCorrectorNr, saiUnassignedNr :: Int }
-
 getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCAssignR = postCAssignR
 postCAssignR tid ssh csh = do
@@ -1140,7 +1203,7 @@ assignHandler tid ssh csh cid assignSids = do
   -- gather data
   (orderedSheetNames, assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
       -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-      nrParticipants <- count [CourseParticipantCourse ==. cid]
+      nrParticipants <- count [CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive ]
 
       sheetList <- selectList [SheetCourse ==. cid] [Desc SheetActiveTo, Desc SheetActiveFrom]
       let orderedSheetNames = fmap (\(Entity _ Sheet{sheetName}) -> sheetName) sheetList

src/Handler/Course/Application/List.hs

@@ -257,6 +257,7 @@ getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -
 getCApplicationsR = postCApplicationsR
 postCApplicationsR tid ssh csh = do
   (table, allocationsBounds, mayAccept) <- runDB $ do
+    now <- liftIO getCurrentTime
     Entity cid Course{..} <- getBy404 $ TermSchoolCourseShort tid ssh csh
 
     csvName <- getMessageRender <*> pure (MsgCourseApplicationsTableCsvName tid ssh csh)
@@ -264,13 +265,13 @@ postCApplicationsR tid ssh csh = do
       allocationLink :: Allocation -> SomeRoute UniWorX
       allocationLink Allocation{..} = SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR
 
-      participantLink :: MonadCrypto m => UserId -> m (SomeRoute UniWorX)
+      participantLink :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (SomeRoute UniWorX)
-      participantLink uid = do
+      participantLink uid = liftHandler $ do
         cID <- encrypt uid
         return . SomeRoute . CourseR tid ssh csh $ CUserR cID
 
-      applicationLink :: MonadCrypto m => CourseApplicationId -> m (SomeRoute UniWorX)
+      applicationLink :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseApplicationId -> m (SomeRoute UniWorX)
-      applicationLink appId = do
+      applicationLink appId = liftHandler $ do
         cID <- encrypt appId
         return . SomeRoute $ CApplicationR tid ssh csh cID CAEditR
       
@@ -288,6 +289,7 @@ postCApplicationsR tid ssh csh = do
         lift $ do
           E.on $ E.just (user E.^. UserId) E.==. courseParticipant E.?. CourseParticipantUser
            E.&&. courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val cid)
+           E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
           E.on $ studyDegree E.?. StudyDegreeId E.==. studyFeatures E.?. StudyFeaturesDegree
           E.on $ studyTerms E.?. StudyTermsId E.==. studyFeatures E.?. StudyFeaturesField
           E.on $ studyFeatures E.?. StudyFeaturesId E.==. courseApplication E.^. CourseApplicationField
@@ -295,6 +297,8 @@ postCApplicationsR tid ssh csh = do
           E.on $ user E.^. UserId E.==. courseApplication E.^. CourseApplicationUser
            E.&&. courseApplication E.^. CourseApplicationCourse E.==. E.val cid
 
+          E.where_ $ E.maybe E.true (E.maybe E.false (E.<=. E.val now)) (allocation E.?. AllocationStaffAllocationFrom)
+
         return ( courseApplication
                , user
                , hasFiles
@@ -305,14 +309,8 @@ postCApplicationsR tid ssh csh = do
                , E.not_ . E.isNothing $ courseParticipant E.?. CourseParticipantId
                )
 
-      dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) CourseApplicationsTableData
+      dbtProj :: DBRow _ -> DB CourseApplicationsTableData
-      dbtProj = runReaderT $ do
+      dbtProj = traverse $ return . over _3 E.unValue . over _8 E.unValue
-        appId <- view $ _dbrOutput . _1 . _entityKey
-        cID <- encrypt appId
-        
-        guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
-
-        asks $ over (_dbrOutput . _3) E.unValue . over (_dbrOutput . _8) E.unValue
 
       dbtRowKey = view $ queryCourseApplication . to (E.^. CourseApplicationId)
 
@@ -431,7 +429,6 @@ postCApplicationsR tid ssh csh = do
             CourseApplicationsTableCsvSetCommentData{} -> CourseApplicationsTableCsvSetComment
         , dbtCsvCoarsenActionClass = const DBCsvActionExisting
         , dbtCsvExecuteActions = do
-            now <- liftIO getCurrentTime
             C.mapM_ $ \case
               CourseApplicationsTableCsvSetFieldData{..} -> do
                 CourseApplication{..} <- updateGet caCsvActApplication [ CourseApplicationField =. caCsvActField
@@ -591,7 +588,7 @@ postCApplicationsR tid ssh csh = do
       psValidator = def
         & defaultSorting [SortAscBy "user-name"]
 
-    participants <- count [ CourseParticipantCourse ==. cid ]
+    participants <- count [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive ]
     let remainingCapacity = subtract participants <$> courseCapacity
 
     allocationsBounds' <- E.select . E.from $ \(allocation `E.InnerJoin` allocationCourse) -> do
@@ -647,7 +644,7 @@ postCApplicationsR tid ssh csh = do
     formResult acceptRes $ \(invMode, appsSecOrder) -> do
       runDBJobs $ do
         Entity cid Course{..} <- getBy404 $ TermSchoolCourseShort tid ssh csh
-        participants <- count [ CourseParticipantCourse ==. cid ]
+        participants <- count [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive ]
         let openCapacity = subtract participants <$> courseCapacity
 
         applications <- E.select . E.from $ \(user `E.InnerJoin` application) -> do
@@ -661,6 +658,7 @@ postCApplicationsR tid ssh csh = do
           E.where_ . E.not_ . E.exists . E.from $ \participant ->
             E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
                  E.&&. participant E.^. CourseParticipantUser E.==. user E.^. UserId
+                 E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
 
           return (user, application)
 
@@ -684,6 +682,8 @@ postCApplicationsR tid ssh csh = do
         mapM_ addMessage' <=< execWriterT $ registerUsers cid applicants
       redirect $ CourseR tid ssh csh CUsersR
 
+  let
+    studyFeaturesWarning = $(i18nWidgetFile "applications-list-info")
 
   siteLayoutMsg title $ do
     setTitleI title

src/Handler/Course/Communication.hs

@@ -40,6 +40,7 @@ postCCommR tid ssh csh = do
         , E.from $ \(user `E.InnerJoin` participant) -> do
             E.on $ user E.^. UserId E.==. participant E.^. CourseParticipantUser
             E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
+                 E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
             return user
         )
       , ( RGCourseLecturers

src/Handler/Course/Edit.hs

@@ -55,10 +55,11 @@ data CourseForm = CourseForm
 data AllocationCourseForm = AllocationCourseForm
   { acfAllocation                :: AllocationId
   , acfMinCapacity               :: Int
+  , acfDeregisterNoShow          :: Bool
   }
 
 courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> Maybe (Entity AllocationCourse) -> CourseForm
-courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
+courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
     { cfCourseId            = Just cid
     , cfName                = courseName
     , cfDesc                = courseDescription
@@ -69,7 +70,7 @@ courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
     , cfCapacity            = courseCapacity
     , cfSecret              = courseRegisterSecret
     , cfMatFree             = courseMaterialFree
-    , cfAllocation          = allocationCourseToForm <$> alloc
+    , cfAllocation          = allocationCourseToForm cEnt <$> alloc
     , cfAppRequired         = courseApplicationsRequired
     , cfAppInstructions     = courseApplicationsInstructions
     , cfAppInstructionFiles
@@ -89,10 +90,11 @@ courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
               return $ courseAppInstructionFile E.^. CourseAppInstructionFileFile
       
 
-allocationCourseToForm :: Entity AllocationCourse -> AllocationCourseForm
+allocationCourseToForm :: Entity Course -> Entity AllocationCourse -> AllocationCourseForm
-allocationCourseToForm (Entity _ AllocationCourse{..}) = AllocationCourseForm
+allocationCourseToForm (Entity _ Course{..}) (Entity _ AllocationCourse{..}) = AllocationCourseForm
   { acfAllocation = allocationCourseAllocation
   , acfMinCapacity = allocationCourseMinCapacity
+  , acfDeregisterNoShow = courseDeregisterNoShow
   }
 
 makeCourseForm :: (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> Maybe CourseForm -> Form CourseForm
@@ -251,6 +253,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
                  in AllocationCourseForm
                     <$> ainp (selectField' Nothing $ return allocationOptions) (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation)
                     <*> ainp (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation)
+                    <*> apopt checkBoxField (fslI MsgCourseDeregisterNoShow & setTooltip MsgCourseDeregisterNoShowTip) ((<|> Just True) . fmap acfDeregisterNoShow $ template >>= cfAllocation)
 
             optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template)
 
@@ -459,6 +462,7 @@ courseEditHandler miButtonAction mbCourseForm = do
                                 , courseRegisterFrom               = cfRegFrom
                                 , courseRegisterTo                 = cfRegTo
                                 , courseDeregisterUntil            = cfDeRegUntil
+                                , courseDeregisterNoShow           = maybe False acfDeregisterNoShow cfAllocation
                                 }
             whenIsJust insertOkay $ \cid -> do
               let (invites, adds) = partitionEithers $ cfLecturers res
@@ -506,6 +510,7 @@ courseEditHandler miButtonAction mbCourseForm = do
                                 , courseRegisterFrom               = cfRegFrom
                                 , courseRegisterTo                 = cfRegTo
                                 , courseDeregisterUntil            = cfDeRegUntil
+                                , courseDeregisterNoShow           = maybe False acfDeregisterNoShow cfAllocation
                                 }
                 case updOkay of
                   (Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False

src/Handler/Course/Events/Edit.hs

@@ -24,6 +24,7 @@ postCEvEditR tid ssh csh cID = do
         , courseEventType = cefType
         , courseEventRoom = cefRoom
         , courseEventTime = cefTime
+        , courseEventNote = cefNote
         , courseEventLastChanged = now
         }
     addMessageI Success MsgCourseEventEdited

src/Handler/Course/Events/Form.hs

@@ -15,6 +15,7 @@ data CourseEventForm = CourseEventForm
   { cefType             :: CI Text
   , cefRoom             :: Text
   , cefTime             :: Occurrences
+  , cefNote             :: Maybe Html
   }
 
 courseEventForm :: Maybe CourseEventForm -> Form CourseEventForm
@@ -34,15 +35,18 @@ courseEventForm template = identifyForm FIDCourseEvent . renderWForm FormStandar
   cefType' <- wreq (textField & cfStrip & cfCI & addDatalist courseEventTypes) (fslI MsgCourseEventType & addPlaceholder (mr MsgCourseEventTypePlaceholder)) (cefType <$> template)
   cefRoom' <- wreq (textField & cfStrip & addDatalist courseEventRooms) (fslI MsgCourseEventRoom) (cefRoom <$> template)
   cefTime' <- aFormToWForm $ occurrencesAForm ("time" :: Text) (cefTime <$> template)
+  cefNote' <- wopt htmlField (fslI MsgCourseEventNote) (cefNote <$> template)
 
   return $ CourseEventForm
     <$> cefType'
     <*> cefRoom'
     <*> cefTime'
+    <*> cefNote'
 
 courseEventToForm :: CourseEvent -> CourseEventForm
 courseEventToForm CourseEvent{..} = CourseEventForm
   { cefType = courseEventType
   , cefRoom = courseEventRoom
   , cefTime = courseEventTime
+  , cefNote = courseEventNote
   }

src/Handler/Course/Events/New.hs

@@ -22,6 +22,7 @@ postCEventsNewR tid ssh csh = do
         , courseEventType        = cefType
         , courseEventRoom        = cefRoom
         , courseEventTime        = cefTime
+        , courseEventNote        = cefNote
         , courseEventLastChanged = now
         }
       encrypt eId :: DB CryptoUUIDCourseEvent

src/Handler/Course/LecturerInvite.hs

@@ -17,6 +17,8 @@ import Data.Aeson hiding (Result(..))
 
 import Text.Hamlet (ihamlet)
 
+import qualified Data.HashSet as HashSet
+
 
 instance IsInvitableJunction Lecturer where
   type InvitationFor Lecturer = Course
@@ -65,7 +67,7 @@ lecturerInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseLecInviteHeading $ CI.original courseName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgCourseLecInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- Right <$> liftHandler requireAuthId
+      itAuthority <- HashSet.singleton . 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

@@ -61,11 +61,13 @@ type CourseTableExpr = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity
 course2Participants :: CourseTableExpr -> E.SqlExpr (E.Value Int)
 course2Participants (course `E.InnerJoin` _school) = E.subSelectCount . E.from $ \courseParticipant ->
     E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+         E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
 
 course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
 course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant ->
     E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
       E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
+      E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
 
 makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h, DBResult m x ~ ((), Widget) )
                      => _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> DB Widget
@@ -83,10 +85,10 @@ makeCourseTable whereClause colChoices psValidator = do
         E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser
         E.where_ $ cid E.==. lecturer E.^. LecturerCourse E.&&. lecturer E.^. LecturerType E.==. E.val CourseLecturer
         return user
-      dbtProj :: DBRow _ -> MaybeT DB CourseTableData
+      dbtProj :: DBRow _ -> DB CourseTableData
       dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> do
-        lecturerList <- lift $ E.select $ E.from $ lecturerQuery $ E.val $ entityKey course
+        lecturerList <- E.select $ E.from $ lecturerQuery $ E.val $ entityKey course
-        courseAlloc <- lift $ getBy (UniqueAllocationCourse $ entityKey course)
+        courseAlloc <- getBy (UniqueAllocationCourse $ entityKey course)
                           >>= traverse (getJustEntity . allocationCourseAllocation . entityVal)
         return (course, participants, registered, school, lecturerList, courseAlloc)
   snd <$> dbTable psValidator DBTable

src/Handler/Course/ParticipantInvite.hs

@@ -7,6 +7,7 @@ module Handler.Course.ParticipantInvite
   , AddParticipantsResult(..)
   , addParticipantsResultMessages
   , registerUsers, registerUser
+  , registerUsers', registerUser'
   ) where
 
 import Import
@@ -14,10 +15,12 @@ import Import
 import Utils.Form
 import Handler.Utils
 import Handler.Utils.Invitations
+import Handler.Utils.Course
 
 import qualified Data.CaseInsensitive as CI
 
 import qualified Data.Set as Set
+import qualified Data.Map as Map
 
 import Jobs.Queue
 
@@ -29,6 +32,8 @@ import Control.Monad.Except (MonadError(..))
 
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
+import qualified Data.HashSet as HashSet
+
 
 -- Invitations for ordinary participants of this course
 instance IsInvitableJunction CourseParticipant where
@@ -37,16 +42,19 @@ instance IsInvitableJunction CourseParticipant where
     { jParticipantRegistration :: UTCTime
     , jParticipantField        :: Maybe StudyFeaturesId
     , jParticipantAllocated    :: Maybe AllocationId
+    , jParticipantState        :: CourseParticipantState
     } deriving (Eq, Ord, Read, Show, Generic, Typeable)
   data InvitationDBData CourseParticipant = InvDBDataParticipant
     -- no data needed in DB to manage participant invitation
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
   data InvitationTokenData CourseParticipant = InvTokenDataParticipant
+    { invTokenParticipantSubmissionGroup :: Maybe SubmissionGroupName
+    }
     deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
   _InvitableJunction = iso
-    (\CourseParticipant{..} -> (courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantField courseParticipantAllocated))
+    (\CourseParticipant{..} -> (courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantField courseParticipantAllocated courseParticipantState))
-    (\(courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantField courseParticipantAllocated) -> CourseParticipant{..})
+    (\(courseParticipantUser, courseParticipantCourse, JunctionParticipant courseParticipantRegistration courseParticipantField courseParticipantAllocated courseParticipantState) -> CourseParticipant{..})
 
 instance ToJSON (InvitableJunction CourseParticipant) where
   toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 }
@@ -61,10 +69,10 @@ instance FromJSON (InvitationDBData CourseParticipant) where
   parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3 }
 
 instance ToJSON (InvitationTokenData CourseParticipant) where
-  toJSON = genericToJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3, omitNothingFields = True }
-  toEncoding = genericToEncoding defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
+  toEncoding = genericToEncoding defaultOptions { fieldLabelModifier = camelToPathPiece' 3, omitNothingFields = True }
 instance FromJSON (InvitationTokenData CourseParticipant) where
-  parseJSON = genericParseJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 }
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 3, omitNothingFields = True }
 
 participantInvitationConfig :: InvitationConfig CourseParticipant
 participantInvitationConfig = InvitationConfig{..}
@@ -81,17 +89,19 @@ participantInvitationConfig = InvitationConfig{..}
     invitationHeading     (Entity _ Course{..}) _ = return . SomeMessage $ MsgCourseParticipantInviteHeading $ CI.original courseName
     invitationExplanation  _                    _ = return [ihamlet|_{SomeMessage MsgCourseParticipantInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- Right <$> liftHandler requireAuthId
+      itAuthority <- HashSet.singleton . Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm (Entity _ Course{..}) _ uid = hoistAForm lift . wFormToAForm $ do
       now <- liftIO getCurrentTime
       studyFeatures <- wreq (studyFeaturesFieldFor Nothing False [] $ Just uid)
           (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) Nothing
-      return . fmap (, ()) $ JunctionParticipant <$> pure now <*> studyFeatures <*> pure Nothing
+      return . fmap (, ()) $ JunctionParticipant <$> pure now <*> studyFeatures <*> pure Nothing <*> pure CourseParticipantActive
-    invitationInsertHook _ _ _ CourseParticipant{..} _ act = do
+    invitationInsertHook _ _ (_, InvTokenDataParticipant{..}) CourseParticipant{..} _ act = do
-      res <- act
+      deleteBy $ UniqueParticipant courseParticipantUser courseParticipantCourse -- there are no foreign key references to @{CourseParticipant}; therefor we can delete and recreate to simulate upsert
+      res <- act -- insertUnique
       audit $ TransactionCourseParticipantEdit courseParticipantCourse courseParticipantUser
+      void $ setUserSubmissionGroup courseParticipantCourse courseParticipantUser invTokenParticipantSubmissionGroup
       return res
     invitationSuccessMsg (Entity _ Course{..}) _ =
       return . SomeMessage $ MsgCourseParticipantInvitationAccepted (CI.original courseName)
@@ -116,11 +126,17 @@ postCAddUserR tid ssh csh = do
     cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
     ((usersToEnlist,formWgt),formEncoding) <- runFormPost . renderWForm FormStandard $ do
       enlist <- wreq checkBoxField (fslI MsgCourseParticipantEnlistDirectly) (Just False)
-      wreq (multiUserField (maybe True not $ formResultToMaybe enlist) Nothing)
+
-              (fslI MsgCourseParticipantInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
+      let submissionGroupOpts = optionsPersist [SubmissionGroupCourse ==. cid] [Asc SubmissionGroupName] submissionGroupName <&> fmap (submissionGroupName . entityVal)
+      mbGrp <- wopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing
+
+      users <- wreq (multiUserField (maybe True not $ formResultToMaybe enlist) Nothing)
+                 (fslI MsgCourseParticipantInviteField & setTooltip MsgMultiEmailFieldTip) Nothing
+
+      return $ Map.fromSet . const <$> mbGrp <*> users
 
     formResultModal usersToEnlist (CourseR tid ssh csh CUsersR) $
-      hoist runDBJobs . registerUsers cid
+      hoist runDBJobs . registerUsers' cid
       
 
     let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading
@@ -133,13 +149,16 @@ postCAddUserR tid ssh csh = do
         }
 
 registerUsers :: CourseId -> Set (Either UserEmail UserId) -> WriterT [Message] (YesodJobDB UniWorX) ()
-registerUsers cid users = do
+registerUsers cid = registerUsers' cid . Map.fromSet (const Nothing)
-  let (emails,uids) = partitionEithers $ Set.toList users
+
+registerUsers' :: CourseId -> Map (Either UserEmail UserId) (Maybe SubmissionGroupName) -> WriterT [Message] (YesodJobDB UniWorX) ()
+registerUsers' cid users = do
+  let (emails,uids) = partitionKeysEither users
 
   -- send Invitation eMails to unkown users
-  lift $ sinkInvitationsF participantInvitationConfig [(mail,cid,(InvDBDataParticipant,InvTokenDataParticipant)) | mail <- emails]
+  lift $ sinkInvitationsF participantInvitationConfig [(mail,cid,(InvDBDataParticipant,InvTokenDataParticipant{..})) | (mail, invTokenParticipantSubmissionGroup) <- Map.toList emails]
   -- register known users
-  tell <=< lift . addParticipantsResultMessages <=< lift . execWriterT $ mapM_ (registerUser cid) uids
+  tell <=< lift . addParticipantsResultMessages <=< lift . execWriterT $ imapM_ (registerUser' cid) uids
 
   unless (null emails) $
     tell . pure <=< messageI Success . MsgCourseParticipantsInvited $ length emails
@@ -170,8 +189,14 @@ addParticipantsResultMessages AddParticipantsResult{..} = execWriterT $ do
 registerUser :: CourseId
              -> UserId
              -> WriterT AddParticipantsResult (YesodJobDB UniWorX) ()
-registerUser cid uid = exceptT tell tell $ do
+registerUser cid uid = registerUser' cid uid Nothing
-  whenM (lift . lift . existsBy $ UniqueParticipant uid cid) $
+
+registerUser' :: CourseId
+              -> UserId
+              -> Maybe SubmissionGroupName
+              -> WriterT AddParticipantsResult (YesodJobDB UniWorX) ()
+registerUser' cid uid mbGrp = exceptT tell tell $ do
+  whenM (lift . lift $ exists [CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive]) $
     throwError $ mempty { aurAlreadyRegistered = Set.singleton uid }
 
   features <- lift . lift $ selectKeysList [ StudyFeaturesUser ==. uid, StudyFeaturesValid ==. True, StudyFeaturesType ==. FieldPrimary ] []
@@ -187,15 +212,24 @@ registerUser cid uid = exceptT tell tell $ do
         = Nothing
 
   courseParticipantRegistration <- liftIO getCurrentTime
-  void . lift . lift . insert $ CourseParticipant
+  void . lift . lift $ upsert
-    { courseParticipantCourse = cid
+    CourseParticipant
-    , courseParticipantUser = uid
+      { courseParticipantCourse = cid
-    , courseParticipantAllocated = Nothing
+      , courseParticipantUser = uid
-    , ..
+      , courseParticipantAllocated = Nothing
-    }
+      , courseParticipantState = CourseParticipantActive
+      , ..
+      }
+    [ CourseParticipantRegistration =. courseParticipantRegistration
+    , CourseParticipantField =. courseParticipantField
+    , CourseParticipantAllocated =. Nothing
+    , CourseParticipantState =. CourseParticipantActive
+    ]
   lift . lift . audit $ TransactionCourseParticipantEdit cid uid
   lift . lift . queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
 
+  void . lift . lift $ setUserSubmissionGroup cid uid mbGrp
+
   return $ case courseParticipantField of
     Nothing -> mempty { aurNoUniquePrimaryField = Set.singleton uid }
     Just _  -> mempty { aurSuccess              = Set.singleton uid }

src/Handler/Course/Register.hs

@@ -48,7 +48,7 @@ courseRegisterForm :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity Course
 courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
   muid <- maybeAuthId
   (registration, application) <- runDB $ do
-    registration <- fmap join . for muid $ getBy . flip UniqueParticipant cid
+    registration <- fmap join . for muid $ fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy . flip UniqueParticipant cid
     application <- fmap (listToMaybe =<<) . for muid $ \uid -> selectList [CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid, CourseApplicationAllocation ==. Nothing] []
     return (registration, application)
   let btn | courseApplicationsRequired
@@ -142,6 +142,8 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
         -> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
 
     when (is _Just $ registration >>= courseParticipantAllocated . entityVal) $
+      wformMessage =<< messageIconI Warning IconExamRegisterFalse MsgCourseDeregistrationNoShow
+    when (is _Just (registration >>= courseParticipantAllocated . entityVal) && courseDeregisterNoShow) $
       wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationLog
       
     return $ CourseRegisterForm
@@ -160,7 +162,7 @@ getCRegisterR tid ssh csh = do
     Nothing -> addMessageI Info MsgLoginNecessary
     (Just uid) -> runDB $ do
       cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-      registration <- getBy (UniqueParticipant uid cid)
+      registration <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
       when (isNothing registration) $ addMessageI Warning MsgRegisterRetry
   redirect $ CourseR tid ssh csh CShowR
 
@@ -199,22 +201,40 @@ postCRegisterR tid ssh csh = do
         = return $ Just ()
       mkRegistration = do
         audit $ TransactionCourseParticipantEdit cid uid
-        insertUnique $ CourseParticipant cid uid cTime crfStudyFeatures Nothing
+        entityKey <$> upsert
+          (CourseParticipant cid uid cTime crfStudyFeatures Nothing CourseParticipantActive)
+          [ CourseParticipantRegistration =. cTime
+          , CourseParticipantField =. crfStudyFeatures
+          , CourseParticipantAllocated =. Nothing
+          , CourseParticipantState =. CourseParticipantActive
+          ]
 
     case courseRegisterButton of
       BtnCourseRegister -> runDB $ do
-        regOk <- (\app reg -> (,) <$> app <*> reg) <$> mkApplication <*> mkRegistration
+        regOk <- (\app reg -> (, reg) <$> app) <$> mkApplication <*> mkRegistration
         case regOk of
           Nothing -> transactionUndo
           Just _  -> addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
       BtnCourseDeregister -> runDB $ do
-        part <- getBy $ UniqueParticipant uid cid
+        part <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
         forM_ part $ \(Entity _partId CourseParticipant{..}) -> do
+          deregisterParticipant uid cid
+
           when (is _Just courseParticipantAllocated) $ do
+            updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive courseDeregisterNoShow ]
+
             now <- liftIO getCurrentTime
             insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing
-
+            let recordNoShow eId = do
-        deregisterParticipant uid cid
+                  didRecord <- is _Just <$> insertUnique ExamResult
+                    { examResultExam = eId
+                    , examResultUser = uid
+                    , examResultResult = ExamNoShow
+                    , examResultLastChanged = now
+                    }
+                  when didRecord $
+                    audit $ TransactionExamResultEdit eId uid
+            when courseDeregisterNoShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
 
         addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
       BtnCourseApply -> runDB $ do
@@ -243,9 +263,9 @@ deleteApplicationFiles appId = do
 deregisterParticipant :: UserId -> CourseId -> DB ()
 deregisterParticipant uid cid = do
   deleteApplications uid cid
-  part <- getBy $ UniqueParticipant uid cid
+  part <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
   forM_ part $ \(Entity partId CourseParticipant{..}) -> do
-    delete $ partId
+    update partId [CourseParticipantState =. CourseParticipantInactive False]
     audit $ TransactionCourseParticipantDeleted cid uid
 
   examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do

src/Handler/Course/Show.hs

@@ -20,16 +20,19 @@ import Handler.Course.Register
 
 import qualified Data.Conduit.List as C
 
+import Handler.Exam.List (mkExamTable)
+
 
 getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCShowR tid ssh csh = do
   mbAid <- maybeAuthId
-  (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events) <- runDB . maybeT notFound $ do
+  (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup) <- runDB . maybeT notFound $ do
     [(E.Entity cid course, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
        <- lift . E.select . E.from $
          \((school `E.InnerJoin` course) `E.LeftOuterJoin` participant) -> do
             E.on $ E.just (course E.^. CourseId) E.==. participant E.?. CourseParticipantCourse
                 E.&&. E.val mbAid E.==. participant E.?. CourseParticipantUser
+                E.&&. participant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
             E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
             E.where_ $ course E.^. CourseTerm      E.==. E.val tid
                  E.&&. course E.^. CourseSchool    E.==. E.val ssh
@@ -38,6 +41,7 @@ getCShowR tid ssh csh = do
             let numParticipants :: E.SqlExpr (E.Value Int)
                 numParticipants = E.subSelectCount . E.from $ \part ->
                   E.where_ $ part E.^. CourseParticipantCourse E.==. course E.^. CourseId
+                       E.&&. part E.^. CourseParticipantState E.==. E.val CourseParticipantActive
             return (course,school E.^. SchoolName, numParticipants, participant)
     staff <- lift . E.select $ E.from $ \(lecturer `E.InnerJoin` user) -> do
       E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
@@ -89,8 +93,19 @@ getCShowR tid ssh csh = do
 
     events' <- fmap (sortOn $ courseEventTime . entityVal) . lift $ selectList [ CourseEventCourse ==. cid ] []
     events <- mapM (\(Entity evId ev) -> (, ev) <$> encrypt evId) events'
+
+    hasSubmissionGroups <- lift . E.selectExists . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup) -> do
+      E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+      E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
+    submissionGroup' <- lift . for mbAid $ \uid ->
+      fmap (listToMaybe . fmap E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup) -> do
+        E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+        E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
+        E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
+        return $ submissionGroup E.^. SubmissionGroupName
+    let submissionGroup = guardOnM (hasSubmissionGroups && is _Just registration) submissionGroup'
   
-    return (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events)
+    return (cid,course,schoolName,participants,registration,lecturers,assistants,correctors,tutors,mAllocation,hasApplicationTemplate,mApplication,news,events,submissionGroup)
 
   let mDereg' = maybe id min (allocationOverrideDeregister =<< mAllocation) <$> courseDeregisterUntil course
   mDereg <- traverse (formatTime SelFormatDateTime) mDereg' 
@@ -125,7 +140,7 @@ getCShowR tid ssh csh = do
         dbtColonnade = dbColonnade $ mconcat
           [ sortable (Just "type") (i18nCell MsgTutorialType) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> textCell $ CI.original tutorialType
           , sortable (Just "name") (i18nCell MsgTutorialName) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> indicatorCell <> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) [whamlet|#{tutorialName}|]
-          , sortable Nothing (i18nCell MsgTutorialTutors) $ \DBRow{ dbrOutput = Entity tutid _ } -> sqlCell $ do
+          , sortable (Just "tutors") (i18nCell MsgTutorialTutors) $ \DBRow{ dbrOutput = Entity tutid _ } -> sqlCell $ do
               tutTutors <- fmap (map $(unValueN 3)) . E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
                 E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
                 E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
@@ -174,6 +189,12 @@ getCShowR tid ssh csh = do
           , ("register-from", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterFrom )
           , ("register-to", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterTo )
           , ("deregister-until", SortColumn $ \tutorial -> tutorial E.^. TutorialDeregisterUntil )
+          , ( "tutors"
+            , SortColumn $ \tutorial -> E.subSelectMaybe . E.from $ \(tutor `E.InnerJoin` user) -> do
+                E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
+                E.where_ $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
+                return . E.min_ $ user E.^. UserSurname
+            )
           ]
         dbtFilter = Map.empty
         dbtFilterUI = const mempty
@@ -188,73 +209,7 @@ getCShowR tid ssh csh = do
       & defaultSorting [SortAscBy "type", SortAscBy "name"]
   (Any hasTutorials, tutorialTable) <- runDB $ dbTable tutorialDBTableValidator tutorialDBTable
 
-  let
+  (Any hasExams, examTable) <- runDB . mkExamTable $ Entity cid course
-    examDBTable = DBTable{..}
-      where
-        dbtSQLQuery exam = do
-          E.where_ $ exam E.^. ExamCourse E.==. E.val cid
-          return exam
-        dbtRowKey = (E.^. ExamId)
-        dbtProj r@DBRow{ dbrOutput = Entity _ Exam{..} } = do
-          guardM . hasReadAccessTo $ CExamR tid ssh csh examName EShowR
-          return r
-        dbtColonnade = dbColonnade $ mconcat
-          [ sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> indicatorCell <> anchorCell (CExamR tid ssh csh examName EShowR) examName
-          , sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
-          , sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
-          , sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
-          , sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
-              mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
-              isRegistered <- case mbAid of
-                Nothing  -> return False
-                Just uid -> existsBy $ UniqueExamRegistration eId uid
-              let label   = bool MsgExamNotRegistered MsgExamRegistered isRegistered
-                  examUrl = CExamR tid ssh csh examName EShowR
-              if | mayRegister -> return $ simpleLinkI (SomeMessage label) examUrl
-                 | otherwise   -> return [whamlet|_{label}|]
-          -- , sortable Nothing mempty $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
-          --     mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
-          --     isRegistered <- case mbAid of
-          --       Nothing  -> return False
-          --       Just uid -> existsBy $ UniqueExamRegistration eId uid
-          --     if
-          --       | mayRegister -> do
-          --           (examRegisterForm, examRegisterEnctype) <- liftHandler . generateFormPost . buttonForm' $ bool [BtnExamRegister] [BtnExamDeregister] isRegistered
-          --           return $ wrapForm examRegisterForm def
-          --             { formAction = Just . SomeRoute $ CExamR tid ssh csh examName ERegisterR
-          --             , formEncoding = examRegisterEnctype
-          --             , formSubmit = FormNoSubmit
-          --             }
-          --       | isRegistered -> return [whamlet|_{MsgExamRegistered}|]
-          --       | otherwise -> return mempty
-          ]
-        dbtSorting = Map.fromList
-          [ ("name", SortColumn $ \exam -> exam E.^. ExamName )
-          , ("time", SortColumn $ \exam -> exam E.^. ExamStart )
-          , ("register-from", SortColumn $ \exam -> exam E.^. ExamRegisterFrom )
-          , ("register-to", SortColumn $ \exam -> exam E.^. ExamRegisterTo )
-          , ("visible", SortColumn $ \exam -> exam E.^. ExamVisibleFrom )
-          , ("registered", SortColumn $ \exam ->
-              case mbAid of
-                Nothing -> E.false
-                Just uid ->
-                  E.exists $ E.from $ \reg -> do
-                    E.where_ $ reg E.^. ExamRegistrationUser E.==. E.val uid
-                    E.where_ $ reg E.^. ExamRegistrationExam E.==. exam E.^. ExamId
-            )
-          ]
-        dbtFilter = Map.empty
-        dbtFilterUI = const mempty
-        dbtStyle = def
-        dbtParams = def
-        dbtIdent :: Text
-        dbtIdent = "exams"
-        dbtCsvEncode = noCsvEncode
-        dbtCsvDecode = Nothing
-
-    examDBTableValidator = def
-      & defaultSorting [SortAscBy "time"]
-  (Any hasExams, examTable) <- runDB $ dbTable examDBTableValidator examDBTable
 
   let visibleNews = any (view _3) news
       showNewsFiles fs = and
@@ -262,6 +217,7 @@ getCShowR tid ssh csh = do
         , length fs <= 3
         , all (notElem pathSeparator . view _2) fs
         ]
+      hiddenEventNotes = all (\(_,CourseEvent{..}) -> is _Nothing courseEventNote) events
   mayCreateNews <- hasWriteAccessTo $ CourseR tid ssh csh CNewsNewR
   mayCreateEvents <- hasWriteAccessTo $ CourseR tid ssh csh CEventsNewR
 

src/Handler/Course/User.hs

@@ -6,9 +6,13 @@ import Import
 
 import Utils.Form
 import Handler.Utils
+import Handler.Utils.SheetType
 import Database.Esqueleto.Utils.TH
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+
+import Database.Persist.Sql (deleteWhereCount)
 
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 
@@ -16,29 +20,196 @@ import Handler.Course.Register
 
 import Jobs.Queue
 
+import Handler.Corrections
+
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import qualified Data.CaseInsensitive as CI
+
+import qualified Data.Conduit.Combinators as C
+
+
+data ExamAction = ExamDeregister
+                | ExamSetResult
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+nullaryPathPiece ''ExamAction $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''ExamAction $ Text.replace "Exam" "ExamUser"
+
+data ExamActionData = ExamDeregisterData
+                    | ExamSetResultData (Maybe ExamResultPassedGrade)
+
+data TutorialAction = TutorialDeregister
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+nullaryPathPiece ''TutorialAction $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''TutorialAction $ Text.replace "Tutorial" "TutorialUser"
+
+data TutorialActionData = TutorialDeregisterData
+
 
 getCUserR, postCUserR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDUser -> Handler Html
 getCUserR = postCUserR
 postCUserR tid ssh csh uCId = do
-  -- Has authorization checks (OR):
+  showSex <- maybe False (userShowSex . entityVal) <$> maybeAuth
-  --
+
-  --   - User is current member of course
+  (course, user@(Entity _ User{..}), registered) <- runDB $ do
-  --   - User has submitted in course
+    uid <- decrypt uCId
-  --   - User is member of registered group for course
+    course@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh
-  --   - User is member of a tutorial for course
-  --   - User is corrector for course
-  --   - User is a tutor for course
-  --   - User is a lecturer for course
-  let currentRoute = CourseR tid ssh csh (CUserR uCId)
-  Entity dozentId (userShowSex -> showSex) <- requireAuth
-  uid <- decrypt uCId
-  -- DB reads
-  (cid, User{..}, mRegistration, thisUniqueNote, noteText, noteEdits, studies) <- runDB $ do
-    cid  <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-    -- Abfrage Benutzerdaten
     user <- get404 uid
-    registration <- getBy (UniqueParticipant uid cid)
+    registered <- exists [ CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive ]
-    -- Abfrage Teilnehmernotiz
+
+    return (course, Entity uid user, registered)
+  
+  sections <- mapM (runMaybeT . ($ user) . ($ course))
+    [ courseUserProfileSection
+    , courseUserNoteSection
+    , courseUserExamsSection
+    , courseUserTutorialsSection
+    , courseUserSubmissionsSection
+    ]
+
+  -- generate output
+  let headingLong
+        | registered
+        , Just sex <- guardOn showSex =<< userSex
+        = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseMemberOf} #{csh} #{tid}|]
+        | registered
+        = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseMemberOf} #{csh} #{tid}|]
+        | Just sex <- guardOn showSex =<< userSex
+        = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseAssociatedWith} #{csh} #{tid}|]
+        | otherwise
+        = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseAssociatedWith} #{csh} #{tid}|]
+      headingShort = prependCourseTitle tid ssh csh $ SomeMessage userDisplayName
+  siteLayout headingLong $ do
+    setTitleI headingShort
+
+    forM_ sections . fromMaybe $ return ()
+
+courseUserProfileSection :: Entity Course -> Entity User -> MaybeT Handler Widget
+courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex = _, ..}) = do
+  showSex <- maybe False (userShowSex . entityVal) <$> maybeAuth
+  currentRoute <- MaybeT getCurrentRoute
+
+  (mRegistration, studies) <- lift . runDB $ do
+    registration <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
+    studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
+      E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
+      E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
+      E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
+      return  (studyfeat, studydegree, studyterms)
+    return (registration, studies)
+
+  ((regFieldRes, regFieldView), regFieldEnctype) <- lift . runFormPost . identifyForm FIDcRegField $ \csrf ->
+    let currentField :: Maybe (Maybe StudyFeaturesId)
+        currentField = courseParticipantField . entityVal <$> mRegistration
+     in over _2 ((toWidget csrf <>) . fvInput) <$> mreq (studyFeaturesFieldFor Nothing True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField
+
+  let registrationFieldFrag :: Text
+      registrationFieldFrag = "registration-field"
+      regFieldWidget = wrapForm regFieldView FormSettings
+        { formMethod = POST
+        , formAction = Just . SomeRoute $ currentRoute :#: registrationFieldFrag
+        , formEncoding = regFieldEnctype
+        , formAttrs = []
+        , formSubmit = FormAutoSubmit
+        , formAnchor = Just registrationFieldFrag
+        }
+  for_ mRegistration $ \(Entity pId CourseParticipant{..}) ->
+    formResult regFieldRes $ \courseParticipantField' -> do
+      lift . runDB $ do
+        update pId [ CourseParticipantField =. courseParticipantField' ]
+        audit $ TransactionCourseParticipantEdit cid uid
+        addMessageI Success MsgCourseStudyFeatureUpdated
+      redirect $ currentRoute :#: registrationFieldFrag
+
+  mayRegister <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CAddUserR
+  let regButton
+        | is _Just mRegistration = BtnCourseDeregister
+        | otherwise = BtnCourseRegister
+  ((regButtonRes, regButtonView), regButtonEnctype) <- lift . runFormPost . identifyForm FIDcRegButton $
+    if | is _Just $ courseParticipantAllocated . entityVal =<< mRegistration
+         -> renderWForm FormStandard $ fmap (regButton, )
+              <$  (wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip)
+              <*> optionalActionW ((,)
+                                     <$> areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing
+                                     <*> apopt checkBoxField (fslI MsgCourseDeregistrationAllocationNoShow & setTooltip MsgCourseDeregistrationAllocationNoShowTip) Nothing
+                                  ) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
+       | otherwise
+         -> \csrf -> pure (FormSuccess (regButton, Nothing), toWidget csrf)
+
+  let registrationButtonFrag :: Text
+      registrationButtonFrag = "registration-button"
+      regButtonWidget = wrapForm' regButton regButtonView FormSettings
+        { formMethod = POST
+        , formAction = Just . SomeRoute $ currentRoute :#: registrationButtonFrag
+        , formEncoding = regButtonEnctype
+        , formAttrs = []
+        , formSubmit = FormSubmit
+        , formAnchor = Just registrationButtonFrag
+        }
+  formResult regButtonRes $ \case
+    _
+      | not mayRegister
+        -> permissionDenied "User may not be registered"
+    (BtnCourseDeregister, mbReason)
+      | Just (Entity _pId CourseParticipant{..}) <- mRegistration
+        -> do
+          lift . runDB $ do
+            deregisterParticipant courseParticipantUser courseParticipantCourse
+
+            whenIsJust mbReason $ \(reason, noShow) -> do
+              updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
+
+              now <- liftIO getCurrentTime
+              insert_ $ AllocationDeregister courseParticipantUser (Just cid) now (Just reason)
+              let recordNoShow eId = do
+                    didRecord <- is _Just <$> insertUnique ExamResult
+                      { examResultExam = eId
+                      , examResultUser = uid
+                      , examResultResult = ExamNoShow
+                      , examResultLastChanged = now
+                      }
+                    when didRecord $
+                      audit $ TransactionExamResultEdit eId uid
+              when noShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
+          addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
+          redirect $ CourseR courseTerm courseSchool courseShorthand CUsersR
+      | otherwise
+        -> invalidArgs ["User not registered"]
+    (BtnCourseRegister, _) -> do
+      now <- liftIO getCurrentTime
+      let field
+            | [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesValid) studies
+            = Just featId
+            | otherwise
+            = Nothing
+      lift . runDBJobs $ do
+        void $ upsert
+          (CourseParticipant cid uid now field Nothing CourseParticipantActive)
+          [ CourseParticipantRegistration =. now
+          , CourseParticipantField =. field
+          , CourseParticipantAllocated =. Nothing
+          , CourseParticipantState =. CourseParticipantActive
+          ]
+        queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
+        audit $ TransactionCourseParticipantEdit cid uid
+      addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
+      redirect currentRoute
+    _other -> error "Invalid @regButton@"
+
+  mRegAt <- for (courseParticipantRegistration . entityVal <$> mRegistration) $ formatTime SelFormatDateTime
+
+  return $(widgetFile "course/user/profile")
+
+      
+courseUserNoteSection :: Entity Course -> Entity User -> MaybeT Handler Widget
+courseUserNoteSection (Entity cid Course{..}) (Entity uid _) = do
+  guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CUsersR
+  
+  currentRoute <- MaybeT getCurrentRoute
+
+  (thisUniqueNote, noteText, noteEdits) <- lift . runDB $ do
     let thisUniqueNote = UniqueCourseUserNote uid cid
     mbNoteEnt <- getBy thisUniqueNote
     (noteText,noteEdits) <- case mbNoteEnt of
@@ -51,13 +222,7 @@ postCUserR tid ssh csh uCId = do
           E.limit 1 -- more will be shown, if changed here
           return (edit E.^. CourseUserNoteEditTime, usr E.^. UserEmail, usr E.^. UserDisplayName, usr E.^. UserSurname)
         return (Just courseUserNoteNote, $(unValueN 4) <$> noteEdits)
-    -- Abfrage Studiengänge
+    return (thisUniqueNote, noteText, noteEdits)
-    studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
-      E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
-      E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
-      E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
-      return  (studyfeat, studydegree, studyterms)
-    return (cid, user, registration, thisUniqueNote, noteText, noteEdits, studies)
   let editByWgt = [whamlet|
           $newline never
           <ul .list--iconless>
@@ -80,7 +245,7 @@ postCUserR tid ssh csh uCId = do
         }
   formResult noteRes $ \mbNote -> do
     now <- liftIO getCurrentTime
-    runDB $ case mbNote of
+    lift . runDB $ case mbNote of
       Nothing -> do
         -- must delete all edits due to foreign key constraints, which does not make sense -> refactor!
         maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy thisUniqueNote)
@@ -88,107 +253,291 @@ postCUserR tid ssh csh uCId = do
         addMessageI Info MsgCourseUserNoteDeleted
       _ | (renderHtml <$> mbNote) == (renderHtml <$> noteText) -> return () -- no changes
       (Just note) -> do
+        dozentId <- requireAuthId
         (Entity noteKey _) <- upsertBy thisUniqueNote (CourseUserNote cid uid note) [CourseUserNoteNote =. note]
         void . insert $ CourseUserNoteEdit dozentId now noteKey
         addMessageI Success MsgCourseUserNoteSaved
     redirect $ currentRoute :#: noteFrag -- reload page after post
 
-  ((regFieldRes, regFieldView), regFieldEnctype) <- runFormPost . identifyForm FIDcRegField $ \csrf ->
+  return $(widgetFile "course/user/note")
-    let currentField :: Maybe (Maybe StudyFeaturesId)
-        currentField = courseParticipantField . entityVal <$> mRegistration
-     in over _2 ((toWidget csrf <>) . fvInput) <$> mreq (studyFeaturesFieldFor Nothing True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField
 
-  let registrationFieldFrag :: Text
-      registrationFieldFrag = "registration-field"
-      regFieldWidget = wrapForm regFieldView FormSettings
-        { formMethod = POST
-        , formAction = Just . SomeRoute $ currentRoute :#: registrationFieldFrag
-        , formEncoding = regFieldEnctype
-        , formAttrs = []
-        , formSubmit = FormAutoSubmit
-        , formAnchor = Just registrationFieldFrag
-        }
-  for_ mRegistration $ \(Entity pId CourseParticipant{..}) ->
-    formResult regFieldRes $ \courseParticipantField' -> do
-      runDB $ do
-        update pId [ CourseParticipantField =. courseParticipantField' ]
-        audit $ TransactionCourseParticipantEdit cid uid
-        addMessageI Success MsgCourseStudyFeatureUpdated
-      redirect $ currentRoute :#: registrationFieldFrag
 
-  mayRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
+courseUserSubmissionsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
-  let regButton
+courseUserSubmissionsSection (Entity cid Course{..}) (Entity uid _) = do
-        | is _Just mRegistration = BtnCourseDeregister
+  guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CCorrectionsR
-        | otherwise = BtnCourseRegister
-  ((regButtonRes, regButtonView), regButtonEnctype) <- runFormPost . identifyForm FIDcRegButton $
-    if | is _Just $ courseParticipantAllocated . entityVal =<< mRegistration
-         -> renderWForm FormStandard $ fmap (regButton, )
-              <$  (wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip)
-              <*> optionalActionW (areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
-       | otherwise
-         -> \csrf -> pure (FormSuccess (regButton, Nothing), toWidget csrf)
 
-  let registrationButtonFrag :: Text
+  let whereClause = (E.&&.) <$> courseIs cid <*> userIs uid
-      registrationButtonFrag = "registration-button"
+      colonnade = mconcat -- should match getSSubsR for consistent UX
-      regButtonWidget = wrapForm' regButton regButtonView FormSettings
+        [ colSelect
-        { formMethod = POST
+        , colSheet
-        , formAction = Just . SomeRoute $ currentRoute :#: registrationButtonFrag
+        , colSMatrikel
-        , formEncoding = regButtonEnctype
+        , colSubmittors
-        , formAttrs = []
+        , colSubmissionLink
-        , formSubmit = FormSubmit
+        , colLastEdit
-        , formAnchor = Just registrationButtonFrag
+        , colRating
-        }
+        , colRated
-  formResult regButtonRes $ \case
+        , colCorrector
-    _
+        , colAssigned
-      | not mayRegister
+        ] -- Continue here
-        -> permissionDenied "User may not be registered"
+      filterUI = Just $ \mPrev -> mconcat
-    (BtnCourseDeregister, mbReason)
+        [ prismAForm (singletonFilter "user-name-email")      mPrev $ aopt textField (fslI MsgCourseMembers)
-      | Just (Entity _pId CourseParticipant{..}) <- mRegistration
+        , prismAForm (singletonFilter "user-matriclenumber")  mPrev $ aopt textField (fslI MsgMatrikelNr)
-        -> do
+        -- "pseudonym" TODO DB only stores Word24
-          runDB $ do
+        , Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
-            deregisterParticipant courseParticipantUser courseParticipantCourse
+        , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
+        , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
+        , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
+        , prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
+        ]
+      psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
+  (cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI psValidator $ Map.fromList
+    [ downloadAction
+    , assignAction (Left cid)
+    , deleteAction
+    ]
 
-            whenIsJust mbReason $ \reason -> do
+  guard $ statistics /= mempty
-              now <- liftIO getCurrentTime
+
-              insert_ $ AllocationDeregister courseParticipantUser (Just cid) now (Just reason)
+  return $(widgetFile "course/user/corrections")
-          addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
+
-          redirect $ CourseR tid ssh csh CUsersR
+
-      | otherwise
+courseUserExamsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
-        -> invalidArgs ["User not registered"]
+courseUserExamsSection (Entity cid Course{..}) (Entity uid _) = do
-    (BtnCourseRegister, _) -> do
+  guardM . hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CExamNewR
+
+  uCID <- encrypt uid
+  
+  let
+    examDBTable = DBTable{..}
+      where
+        dbtSQLQuery exam = do
+          E.where_ $ exam E.^. ExamCourse E.==. E.val cid
+          E.where_ $ E.or
+            [ E.exists . E.from $ \examRegistration ->
+                E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
+                     E.&&. examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
+            , E.exists . E.from $ \(examPart `E.InnerJoin` examPartResult) -> do
+                E.on $ examPart E.^. ExamPartId E.==. examPartResult E.^. ExamPartResultExamPart
+                E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
+                     E.&&. examPart E.^. ExamPartExam E.==. exam E.^. ExamId
+            , E.exists . E.from $ \examBonus ->
+                E.where_ $ examBonus E.^. ExamBonusUser E.==. E.val uid
+                     E.&&. examBonus E.^. ExamBonusExam E.==. exam E.^. ExamId
+            , E.exists . E.from $ \examResult ->
+                E.where_ $ examResult E.^. ExamResultUser E.==. E.val uid
+                     E.&&. examResult E.^. ExamResultExam E.==. exam E.^. ExamId
+            ]
+          return exam
+        dbtRowKey = (E.^. ExamId)
+        dbtProj = traverse $ \exam@(Entity eId _) -> do
+          registration <- getBy $ UniqueExamRegistration eId uid
+          occurrence <- runMaybeT $ do
+            Entity _ ExamRegistration{..} <- hoistMaybe registration
+            occId <- hoistMaybe examRegistrationOccurrence
+            MaybeT $ getEntity occId
+          bonus <- getBy $ UniqueExamBonus eId uid
+          result <- getBy $ UniqueExamResult eId uid
+
+          return ( exam
+                 , occurrence
+                 , bonus
+                 , result
+                 , registration
+                 )
+        dbtColonnade = mconcat
+          [ dbSelect (_2 . applying _2) _1 $ return . view (_dbrOutput . _1 . _entityKey)
+          , sortable (Just "name") (i18nCell MsgExamName) $ tellCell (Any True, mempty) . anchorCell' (\(view $ _dbrOutput . _1 . _entityVal -> Exam{..}) -> CExamR courseTerm courseSchool courseShorthand examName EShowR) (view $ _dbrOutput . _1 . _entityVal . _examName)
+          , sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (cell . toWidget) . preview (_dbrOutput . _2 . _Just . _entityVal . _examOccurrenceName)
+          , sortable (Just "registration-time") (i18nCell MsgExamRegistrationTime) $ maybe mempty (cell . formatTimeW SelFormatDateTime) . preview (_dbrOutput . _5 . _Just . _entityVal . _examRegistrationTime)
+          , sortable (Just "bonus") (i18nCell MsgExamBonusAchieved) $ maybe mempty i18nCell . preview (_dbrOutput . _3 . _Just . _entityVal . _examBonusBonus)
+          , sortable (Just "result") (i18nCell MsgExamResult) $ maybe mempty i18nCell . preview (_dbrOutput . _4 . _Just . _entityVal . _examResultResult)
+          ]
+        dbtSorting = mconcat
+          [ singletonMap "name" . SortColumn $ \exam -> exam E.^. ExamName
+          , singletonMap "occurrence" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \(examOccurrence `E.InnerJoin` examRegistration) -> do
+              E.on $ examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
+              E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
+                   E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
+              return . E.just $ examOccurrence E.^. ExamOccurrenceName
+          , singletonMap "registration-time" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examRegistration -> do
+              E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
+                   E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
+              return . E.just $ examRegistration E.^. ExamRegistrationTime
+          , singletonMap "bonus" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examBonus -> do
+              E.where_ $ examBonus E.^. ExamBonusExam E.==. exam E.^. ExamId
+                   E.&&. examBonus E.^. ExamBonusUser E.==. E.val uid
+              return . E.just $ examBonus E.^. ExamBonusBonus
+          , singletonMap "result" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examResult -> do
+              E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
+                   E.&&. examResult E.^. ExamResultUser E.==. E.val uid
+              return . E.just $ examResult E.^. ExamResultResult
+          ]
+        dbtFilter = mempty
+        dbtFilterUI _mPrev = mempty
+        dbtStyle = def
+        dbtParams = DBParamsForm
+          { dbParamsFormMethod = POST
+          , dbParamsFormAction = Just . SomeRoute . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
+          , dbParamsFormAttrs  = []
+          , dbParamsFormSubmit = FormSubmit
+          , dbParamsFormAdditional = \csrf -> do
+              let
+                actionMap :: Map ExamAction (AForm Handler ExamActionData)
+                actionMap = mconcat
+                  [ singletonMap ExamDeregister $
+                      pure ExamDeregisterData
+                  , singletonMap ExamSetResult $
+                      ExamSetResultData <$> aopt (examResultModeField (Just $ SomeMessage MsgExamResultNone) ExamGradingMixed) (fslI MsgExamResult) Nothing
+                  ]
+
+              (res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
+              let formRes = (, mempty) . First . Just <$> res
+              return (formRes, formWgt)
+          , dbParamsFormEvaluate = liftHandler . runFormPost
+          , dbParamsFormResult = _2
+          , dbParamsFormIdent = def
+          }
+        dbtIdent :: Text
+        dbtIdent = "course-user-exams"
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+    examDBTableValidator = def & defaultSorting [SortAscBy "registration-time"]
+    postprocess :: FormResult (First ExamActionData, DBFormResult ExamId (Bool, _) _) -> FormResult (ExamActionData, Map ExamId _)
+    postprocess inp = do
+      (First (Just act), regMap) <- inp
+      let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
+      return (act, regMap')
+  ((Any hasExams, actRes), examTable) <- lift . runDB $ over (_1 . _2) postprocess <$> dbTable examDBTableValidator examDBTable
+
+  lift . formResult actRes $ \case
+    (ExamDeregisterData, Map.keys -> selectedExams) -> do
+      nrDel <- runDB $ deleteWhereCount
+        [ ExamRegistrationUser ==. uid
+        , ExamRegistrationExam <-. selectedExams
+        ]
+      if | nrDel > 0 -> addMessageI Success $ MsgCourseUserExamsDeregistered nrDel
+         | otherwise -> addMessageI Info MsgCourseUserNoExamsDeregistered
+      redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
+    (ExamSetResultData mRes, selectedExams) -> do
       now <- liftIO getCurrentTime
-      let field
+      Sum nrUpdated <- runDB . flip ifoldMapM selectedExams $ \eId (view $ _dbrOutput . _1 . _entityVal -> Exam{..}) -> if
-            | [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesValid) studies
+        | hasExamGradingGrades examGradingMode || isn't (_Just . _ExamAttended . _Right) mRes
-            = Just featId
+        , hasExamGradingPass   examGradingMode || isn't (_Just . _ExamAttended . _Left ) mRes
-            | otherwise
+          -> do
-            = Nothing
+            oldResult <- getBy $ UniqueExamResult eId uid
-      pId <- runDBJobs $ do
+            case mRes of
-        pId <- insertUnique $ CourseParticipant cid uid now field Nothing
+              Just res
-        when (is _Just pId) $ do
+                | maybe True ((/= res) . examResultResult . entityVal) oldResult -> do
-          queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
+                    void $ upsert
-          audit $ TransactionCourseParticipantEdit cid uid
+                      ExamResult
-        return pId
+                        { examResultExam = eId
-      case pId of
+                        , examResultUser = uid
-        Just _  -> do
+                        , examResultResult = res
-          addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
+                        , examResultLastChanged = now
-          redirect currentRoute
+                        }
-        Nothing -> invalidArgs ["User already registered"]
+                      [ ExamResultResult =. res, ExamResultLastChanged =. now ]
-    _other -> error "Invalid @regButton@"
+                    audit $ TransactionExamResultEdit eId uid
+                    return $ Sum 1
+              Nothing
+                | is _Just oldResult -> do
+                    deleteBy $ UniqueExamResult eId uid
+                    audit $ TransactionExamResultDeleted eId uid
+                    return $ Sum 1
+              _other -> return mempty
+        | otherwise -> mempty <$ addMessageI Error (MsgCourseUserExamResultDoesNotMatchMode examName)
+      when (nrUpdated > 0) . addMessageI Success $ MsgCourseUserExamsResultSet nrUpdated
+      redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
 
-  mRegAt <- for (courseParticipantRegistration . entityVal <$> mRegistration) $ formatTime SelFormatDateTime
+  guard hasExams
 
-  -- generate output
+  return $(widgetFile "course/user/exams")
-  let headingLong
+
-        | is _Just mRegistration
+
-        , Just sex <- guardOn showSex =<< userSex
+courseUserTutorialsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
-        = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseMemberOf} #{csh} #{tid}|]
+courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
-        | is _Just mRegistration
+  uCID <- encrypt uid
-        = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseMemberOf} #{csh} #{tid}|]
+
-        | Just sex <- guardOn showSex =<< userSex
+  let
-        = [whamlet|^{nameWidget userDisplayName userSurname} (_{ShortSex sex}), _{MsgCourseAssociatedWith} #{csh} #{tid}|]
+    tutorialDBTable = DBTable{..}
-        | otherwise
+      where
-        = [whamlet|^{nameWidget userDisplayName userSurname}, _{MsgCourseAssociatedWith} #{csh} #{tid}|]
+        dbtSQLQuery (tutorial `E.InnerJoin` tutorialParticipant) = do
-      headingShort = prependCourseTitle tid ssh csh $ SomeMessage userDisplayName
+          E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
-  siteLayout headingLong $ do
+          E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
-    setTitleI headingShort
+               E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid
-    $(widgetFile "course-user")
+          return (tutorial, tutorialParticipant)
+        dbtRowKey (_ `E.InnerJoin` tutorialParticipant) = tutorialParticipant E.^. TutorialParticipantId
+        dbtProj = traverse $ \(tutorial, tutorialParticipant) -> do
+          tutors <- E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
+            E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
+            E.where_ $ tutor E.^. TutorTutorial E.==. E.val (tutorial ^. _entityKey)
+            return user
+          return (tutorial, tutorialParticipant, tutors)
+        dbtColonnade = mconcat
+          [ dbSelect (_2 . applying _2) _1 $ return . view (_dbrOutput . _2 . _entityKey)
+          , sortable (Just "type") (i18nCell MsgTutorialType) $ textCell . CI.original . view (_dbrOutput . _1 . _entityVal . _tutorialType)
+          , sortable (Just "name") (i18nCell MsgTutorialName) $ tellCell (Any True, mempty) . anchorCell' (\(view $ _dbrOutput . _1 . _entityVal . _tutorialName -> tutn) -> CTutorialR courseTerm courseSchool courseShorthand tutn TUsersR) (view $ _dbrOutput . _1 . _entityVal . _tutorialName)
+          , sortable (Just "tutors") (i18nCell MsgTutorialTutors) $ \(view $ _dbrOutput . _3 -> tutors) -> cell
+              [whamlet|
+                $newline never
+                <ul .list--iconless .list--inline .list--comma-separated>
+                  $forall (Entity _ User{userEmail, userDisplayName, userSurname}) <- tutors
+                    <li>
+                      ^{nameEmailWidget userEmail userDisplayName userSurname}
+              |]
+          , sortable (Just "room") (i18nCell MsgTutorialRoom) $ maybe mempty textCell . view (_dbrOutput . _1 . _entityVal . _tutorialRoom)
+          , sortable Nothing (i18nCell MsgTutorialTime) $ occurrencesCell . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
+          ]
+        dbtSorting = mconcat
+          [ singletonMap "type" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialType
+          , singletonMap "name" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialName
+          , singletonMap "room" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialRoom
+          , singletonMap "tutors" . SortColumn $ \(tutorial `E.InnerJoin` _) -> E.subSelectMaybe . E.from $ \(tutor `E.InnerJoin` user) -> do
+              E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
+              E.where_ $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
+              return . E.min_ $ user E.^. UserSurname
+          ]
+        dbtFilter = mempty
+        dbtFilterUI _mPrev = mempty
+        dbtStyle = def
+        dbtParams = DBParamsForm
+          { dbParamsFormMethod = POST
+          , dbParamsFormAction = Just . SomeRoute . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
+          , dbParamsFormAttrs  = []
+          , dbParamsFormSubmit = FormSubmit
+          , dbParamsFormAdditional = \csrf -> do
+              let
+                actionMap :: Map TutorialAction (AForm Handler TutorialActionData)
+                actionMap = mconcat
+                  [ singletonMap TutorialDeregister $
+                      pure TutorialDeregisterData
+                  ]
+
+              (res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
+              let formRes = (, mempty) . First . Just <$> res
+              return (formRes, formWgt)
+          , dbParamsFormEvaluate = liftHandler . runFormPost
+          , dbParamsFormResult = _2
+          , dbParamsFormIdent = def
+          }
+        dbtIdent :: Text
+        dbtIdent = "tutorials"
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+    tutorialDBTableValidator = def & defaultSorting [SortAscBy "type", SortAscBy "name"]
+    postprocess :: FormResult (First TutorialActionData, DBFormResult TutorialParticipantId (Bool, _) _) -> FormResult (TutorialActionData, Map TutorialParticipantId _)
+    postprocess inp = do
+      (First (Just act), regMap) <- inp
+      let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
+      return (act, regMap')
+  ((Any hasTutorials, actRes), tutorialTable) <- lift . runDB $ over (_1 . _2) postprocess <$> dbTable tutorialDBTableValidator tutorialDBTable
+
+  lift . formResult actRes $ \case
+    (TutorialDeregisterData, Map.keys -> selectedTutParts) -> do
+      nrDel <- runDB $ deleteWhereCount [ TutorialParticipantId <-. selectedTutParts ]
+      if | nrDel > 0 -> addMessageI Success $ MsgCourseUserTutorialsDeregistered nrDel
+         | otherwise -> addMessageI Info MsgCourseUserNoTutorialsDeregistered
+      redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
+
+  guard hasTutorials
+
+  return $(widgetFile "course/user/tutorials")

src/Handler/Course/Users.hs

@@ -11,6 +11,7 @@ import Import
 
 import Utils.Form
 import Handler.Utils
+import Handler.Utils.Course
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
@@ -29,6 +30,8 @@ import qualified Data.Conduit.List as C
 
 import qualified Data.CaseInsensitive as CI
 
+import Database.Persist.Sql (updateWhereCount)
+
 
 type UserTableExpr   = (               E.SqlExpr (Entity User)
                          `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)
@@ -38,6 +41,9 @@ type UserTableExpr   = (               E.SqlExpr (Entity User)
                          `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyDegree))
                          `E.InnerJoin` E.SqlExpr (Maybe (Entity StudyTerms))
                        )
+     `E.LeftOuterJoin` (               E.SqlExpr (Maybe (Entity SubmissionGroup))
+                         `E.InnerJoin` E.SqlExpr (Maybe (Entity SubmissionGroupUser))
+                       )
 
 -- forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
 -- forceUserTableType = id
@@ -45,54 +51,66 @@ type UserTableExpr   = (               E.SqlExpr (Entity User)
 -- Sql-Getters for this query, used for sorting and filtering (cannot be lenses due to being Esqueleto expressions)
 -- This ought to ease refactoring the query
 queryUser :: UserTableExpr -> E.SqlExpr (Entity User)
-queryUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
+queryUser = $(sqlIJproj 2 1) . $(sqlLOJproj 4 1)
 
 queryParticipant :: UserTableExpr -> E.SqlExpr (Entity CourseParticipant)
-queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
+queryParticipant = $(sqlIJproj 2 2) . $(sqlLOJproj 4 1)
 
 queryUserNote ::  UserTableExpr -> E.SqlExpr (Maybe (Entity CourseUserNote))
-queryUserNote = $(sqlLOJproj 3 2)
+queryUserNote = $(sqlLOJproj 4 2)
 
 queryFeaturesStudy ::  UserTableExpr -> E.SqlExpr (Maybe (Entity StudyFeatures))
-queryFeaturesStudy  = $(sqlIJproj 3 1) . $(sqlLOJproj 3 3)
+queryFeaturesStudy  = $(sqlIJproj 3 1) . $(sqlLOJproj 4 3)
 
 queryFeaturesDegree :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyDegree))
-queryFeaturesDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 3 3)
+queryFeaturesDegree = $(sqlIJproj 3 2) . $(sqlLOJproj 4 3)
 
 queryFeaturesField :: UserTableExpr -> E.SqlExpr (Maybe (Entity StudyTerms))
-queryFeaturesField  = $(sqlIJproj 3 3) . $(sqlLOJproj 3 3)
+queryFeaturesField  = $(sqlIJproj 3 3) . $(sqlLOJproj 4 3)
+
+querySubmissionGroup :: UserTableExpr -> E.SqlExpr (Maybe (Entity SubmissionGroup))
+querySubmissionGroup = $(sqlIJproj 2 1) . $(sqlLOJproj 4 4)
 
 
 userTableQuery :: CourseId -> UserTableExpr -> E.SqlQuery ( E.SqlExpr (Entity User)
-                                                          , E.SqlExpr (E.Value UTCTime)
+                                                          , E.SqlExpr (Entity CourseParticipant)
                                                           , E.SqlExpr (E.Value (Maybe (Key CourseUserNote)))
-                                                          , StudyFeaturesDescription')
+                                                          , StudyFeaturesDescription'
-userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures) = do
+                                                          , E.SqlExpr (Maybe (Entity SubmissionGroup))
+                                                          )
+userTableQuery cid ((user `E.InnerJoin` participant) `E.LeftOuterJoin` note `E.LeftOuterJoin` studyFeatures `E.LeftOuterJoin` (subGroup `E.InnerJoin` subGroupUser)) = do
   -- Note that order of E.on for nested joins is seemingly right-to-left, ignoring nesting paranthesis
+  E.on $ subGroup E.?. SubmissionGroupId E.==. subGroupUser E.?. SubmissionGroupUserSubmissionGroup
+  E.on $ subGroupUser E.?. SubmissionGroupUserUser E.==. E.just (user E.^. UserId)
+   E.&&. subGroup E.?. SubmissionGroupCourse E.==. E.just (E.val cid)
   features <- studyFeaturesQuery' (participant E.^. CourseParticipantField) studyFeatures
   E.on $  (note E.?. CourseUserNoteUser   E.==. E.just (participant E.^. CourseParticipantUser))
     E.&&. (note E.?. CourseUserNoteCourse E.==. E.just (E.val cid))
   E.on $     participant E.^. CourseParticipantUser   E.==. user E.^. UserId
   E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
-  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId, features)
+  return (user, participant, note E.?. CourseUserNoteId, features, subGroup)
 
 
 type UserTableData = DBRow ( Entity User
-                           , UTCTime
+                           , Entity CourseParticipant
                            , Maybe CourseUserNoteId
                            , (Maybe StudyFeatures, Maybe StudyDegree, Maybe StudyTerms)
                            , ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial)))
+                           , [Entity Exam]
+                           , Maybe (Entity SubmissionGroup)
                            )
 
 instance HasEntity UserTableData User where
   hasEntity = _dbrOutput . _1
 
 instance HasUser UserTableData where
-  -- hasUser = _entityVal
   hasUser = _dbrOutput . _1 . _entityVal
 
+_userTableParticipant :: Lens' UserTableData (Entity CourseParticipant)
+_userTableParticipant = _dbrOutput . _2
+
 _userTableRegistration :: Lens' UserTableData UTCTime
-_userTableRegistration = _dbrOutput . _2
+_userTableRegistration = _userTableParticipant . _entityVal . _courseParticipantRegistration
 
 _userTableNote :: Lens' UserTableData (Maybe CourseUserNoteId)
 _userTableNote = _dbrOutput . _3
@@ -106,11 +124,17 @@ _rowUserSemester = _userTableFeatures . _1 . _Just . _studyFeaturesSemester
 _userTutorials :: Lens' UserTableData ([Entity Tutorial], Map (CI Text) (Maybe (Entity Tutorial)))
 _userTutorials = _dbrOutput . _5
 
+_userExams :: Lens' UserTableData [Entity Exam]
+_userExams = _dbrOutput . _6
+
+_userSubmissionGroup :: Traversal' UserTableData (Entity SubmissionGroup)
+_userSubmissionGroup = _dbrOutput . _7 . _Just
+
 
 colUserComment :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
 colUserComment tid ssh csh =
     sortable (Just "note") (i18nCell MsgCourseUserNote)
-      $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey, _, _) } ->
+      $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey, _, _, _, _) } ->
         maybeEmpty mbNoteKey $ const $
           anchorCellM (courseLink <$> encrypt uid) (hasComment True)
   where
@@ -124,6 +148,14 @@ colUserTutorials tid ssh csh = sortable (Just "tutorials") (i18nCell MsgCourseUs
           (\(Entity _ Tutorial{..}) -> CTutorialR tid ssh csh tutorialName TUsersR)
           (tutorialName . entityVal)
 
+colUserExams :: IsDBTable m c => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable UserTableData (DBCell m c)
+colUserExams tid ssh csh = sortable (Just "exams") (i18nCell MsgCourseUserExams)
+  $ \(view _userExams -> exams') ->
+    let exams = sortOn (examName . entityVal) exams'
+     in (cellAttrs <>~ [("class", "list--inline list--comma-separated list--iconless")]) . listCell exams $ anchorCell'
+          (\(Entity _ Exam{..}) -> CExamR tid ssh csh examName EUsersR)
+          (examName . entityVal)
+
 colUserSemester :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserSemester = sortable (Just "semesternr") (i18nCell MsgStudyFeatureAge) $
     foldMap numCell . preview _rowUserSemester
@@ -147,6 +179,10 @@ colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDeg
 colUserSex' :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserSex' = colUserSex $ hasUser . _userSex
 
+colUserSubmissionGroup :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
+colUserSubmissionGroup = sortable (Just "submission-group") (i18nCell MsgSubmissionGroup) $
+  foldMap (cell . toWidget) . preview (_userSubmissionGroup . _entityVal . _submissionGroupName)
+
 
 data UserTableCsvStudyFeature = UserTableCsvStudyFeature
   { csvUserField :: Text
@@ -162,9 +198,11 @@ data UserTableCsv = UserTableCsv
   , csvUserMatriculation :: Maybe Text
   , csvUserEmail :: CI Email
   , csvUserStudyFeatures :: Either (Maybe UserTableCsvStudyFeature) (Set UserTableCsvStudyFeature)
+  , csvUserSubmissionGroup :: Maybe SubmissionGroupName
   , csvUserRegistration :: UTCTime
   , csvUserNote :: Maybe Html
   , csvUserTutorials :: ([TutorialName], Map (CI Text) (Maybe TutorialName))
+  , csvUserExams :: [ExamName]
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 makeLenses_ ''UserTableCsv
 
@@ -187,12 +225,17 @@ instance Csv.ToNamedRecord UserTableCsv where
                  in [ "study-features" Csv..= featsStr
                     ]
       ++
+    [ "submission-group" Csv..= csvUserSubmissionGroup
+    ] ++
     [ let tutsStr = Text.intercalate "; " . map CI.original $ csvUserTutorials ^. _1
        in "tutorial" Csv..= tutsStr
     ] ++
     [ encodeUtf8 (CI.foldedCase regGroup) Csv..= (CI.original <$> mTut)
     | (regGroup, mTut) <- Map.toList $ csvUserTutorials ^. _2
     ] ++
+    [ let examsStr = Text.intercalate "; " $ map CI.original csvUserExams
+       in "exams" Csv..= examsStr
+    ] ++
     [ "registration" Csv..= csvUserRegistration
     , "note" Csv..= csvUserNote
     ]
@@ -206,7 +249,9 @@ instance CsvColumnsExplained UserTableCsv where
     , single "field"               MsgCsvColumnUserField
     , single "degree"              MsgCsvColumnUserDegree
     , single "semester"            MsgCsvColumnUserSemester
+    , single "submission-group"    MsgCsvColumnUserSubmissionGroup
     , single "tutorial"            MsgCsvColumnUserTutorial
+    , single "exams"               MsgCsvColumnUserExam
     , single "registration"        MsgCsvColumnUserRegistration
     , single "note"                MsgCsvColumnUserNote
     ]
@@ -228,7 +273,7 @@ userTableCsvHeader showSex UserCsvExportData{..} tuts = Csv.header $
   ] ++ bool (pure "study-features") ["field", "degree", "semester"] csvUserSimplifiedFeaturesOfStudy ++
   [ "tutorial" | hasEmptyRegGroup ] ++
   map (encodeUtf8 . CI.foldedCase) regGroups ++
-  [ "registration", "note"
+  [ "exams", "registration", "note"
   ]
   where
     hasEmptyRegGroup = has (folded . _entityVal . _tutorialRegGroup . _Nothing) tuts
@@ -238,6 +283,9 @@ userTableCsvHeader showSex UserCsvExportData{..} tuts = Csv.header $
 data CourseUserAction = CourseUserSendMail
                       | CourseUserDeregister
                       | CourseUserRegisterTutorial
+                      | CourseUserRegisterExam
+                      | CourseUserSetSubmissionGroup
+                      | CourseUserReRegister
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
 
 instance Universe CourseUserAction
@@ -247,11 +295,18 @@ embedRenderMessage ''UniWorX ''CourseUserAction id
 
 data CourseUserActionData = CourseUserSendMailData
                           | CourseUserDeregisterData
-                            { deregisterReason :: Maybe Text
+                            { deregisterSelfImposed :: Maybe (Text, Bool {- no-show -})
                             }
                           | CourseUserRegisterTutorialData
                             { registerTutorial :: TutorialId
                             }
+                          | CourseUserRegisterExamData
+                            { registerExam :: (ExamId, Maybe ExamOccurrenceId)
+                            }
+                          | CourseUserSetSubmissionGroupData
+                            { setSubmissionGroup :: Maybe SubmissionGroupName
+                            }
+                          | CourseUserReRegisterData
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
@@ -271,19 +326,22 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
     Course{..} <- getJust cid
     csvName <- getMessageRender <*> pure (MsgCourseUserCsvName courseTerm courseSchool courseShorthand)
     tutorials <- selectList [ TutorialCourse ==. cid ] []
+    exams <- selectList [ ExamCourse ==. cid ] []
     -- -- psValidator has default sorting and filtering
     showSex <- getShowSex
     let dbtIdent     = "courseUsers" :: Text
         dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout }
         dbtSQLQuery q = userTableQuery cid q <* E.where_ (restrict q)
         dbtRowKey    = queryUser >>> (E.^. UserId)
-        dbtProj      = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> do
+        dbtProj      = traverse $ \(user, participant, E.Value userNoteId, (feature,degree,terms), subGroup) -> do
-          tuts'' <- lift $ selectList [ TutorialParticipantUser ==. entityKey user, TutorialParticipantTutorial <-. map entityKey tutorials ] []
+          tuts'' <- selectList [ TutorialParticipantUser ==. entityKey user, TutorialParticipantTutorial <-. map entityKey tutorials ] []
+          exams' <- selectList [ ExamRegistrationUser ==. entityKey user ] []
           let
             regGroups = setOf (folded . _entityVal . _tutorialRegGroup . _Just) tutorials
             tuts' = filter (\(Entity tutId _) -> any ((== tutId) . tutorialParticipantTutorial . entityVal) tuts'') tutorials
             tuts = foldr (\tut@(Entity _ Tutorial{..}) -> maybe (over _1 $ cons tut) (over _2 . flip (Map.insertWith (<|>)) (Just tut)) tutorialRegGroup) ([], Map.fromSet (const Nothing) regGroups) tuts'
-          return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms), tuts)
+            exs = filter (\(Entity eId _) -> any ((== eId) . examRegistrationExam . entityVal) exams') exams
+          return (user, participant, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms), tuts, exs, subGroup)
         dbtColonnade = colChoices
         dbtSorting   = mconcat
           [ single $ sortUserNameLink    queryUser -- slower sorting through clicking name column header
@@ -310,6 +368,15 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                   E.where_ $ participant E.^. TutorialParticipantUser E.==. user E.^. UserId
                   return . E.min_ $ tutorial E.^. TutorialName
             )
+          , single $ ("exams"       , SortColumn $ queryUser >>> \user ->
+                E.subSelectMaybe . E.from $ \(exam `E.InnerJoin` examRegistration) -> do
+                  E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
+                   E.&&. exam E.^. ExamCourse E.==. E.val cid
+                  E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
+                  return . E.min_ $ exam E.^. ExamName
+            )
+          , single $ ("submission-group", SortColumn $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
+          , single $ ("state", SortColumn $ queryParticipant >>> (E.^. CourseParticipantState))
           ]
           where single = uncurry Map.singleton
         dbtFilter    = mconcat
@@ -339,18 +406,30 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                                 E.&&. E.hasInfix (tutorial E.^. TutorialName) (E.val criterion :: E.SqlExpr (E.Value (CI Text)))
                                 E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser row E.^. UserId
                      )
+          , single $ ("exam"        , FilterColumn $ E.mkExistsFilter $ \row criterion -> 
+                         E.from $ \(exam `E.InnerJoin` examRegistration) -> do
+                           E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
+                           E.where_ $ exam E.^. ExamCourse E.==. E.val cid
+                                E.&&. E.hasInfix (exam E.^. ExamName) (E.val criterion :: E.SqlExpr (E.Value (CI Text)))
+                                E.&&. examRegistration E.^. ExamRegistrationUser E.==.queryUser row E.^. UserId
+                     )
           -- , ("course-registration", error "TODO") -- TODO
           -- , ("course-user-note", error "TODO") -- TODO
+          , single $ ("submission-group", FilterColumn $ E.mkContainsFilter $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
+          , single $ ("active", FilterColumn $ E.mkExactFilter $ queryParticipant >>> (E.==. E.val CourseParticipantActive) . (E.^. CourseParticipantState))
           ]
           where single = uncurry Map.singleton
         dbtFilterUI mPrev = mconcat $
-          [ fltrUserNameEmailUI  mPrev
+          [ prismAForm (singletonFilter "active" . maybePrism _PathPiece) mPrev $ aopt (courseParticipantStateIsActiveField . Just $ SomeMessage MsgNoFilter) (fslI MsgCourseParticipantStateIsActiveFilter)
+          , fltrUserNameEmailUI  mPrev
           , fltrUserMatriclenrUI mPrev
           ] ++
           [ fltrUserSexUI mPrev | showSex ] ++
           [ prismAForm (singletonFilter "degree")   mPrev $ aopt textField (fslI MsgStudyFeatureDegree)
           , prismAForm (singletonFilter "field")    mPrev $ aopt textField (fslI MsgCourseStudyFeature)
-          , prismAForm (singletonFilter "tutorial") mPrev $ aopt textField (fslI MsgCourseTutorial)
+          , prismAForm (singletonFilter "submission-group") mPrev $ aopt textField (fslI MsgSubmissionGroup)
+          , prismAForm (singletonFilter "tutorial") mPrev $ aopt textField (fslI MsgCourseUserTutorial)
+          , prismAForm (singletonFilter "exam")     mPrev $ aopt textField (fslI MsgCourseUserExam)
           ]
         dbtParams    = DBParamsForm
           { dbParamsFormMethod = POST
@@ -406,12 +485,16 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
                                 , csvUserSemester = studyFeaturesSemester
                                 , csvUserType = studyFeaturesType
                                 }
+                  <*> preview (_userSubmissionGroup . _entityVal . _submissionGroupName)
                   <*> view _userTableRegistration
                   <*> userNote
                   <*> (over (_2.traverse._Just) (tutorialName . entityVal) . over (_1.traverse) (tutorialName . entityVal) <$> view _userTutorials)
+                  -- <*> (over (_2.traverse._Just) (examName . entityVal) . over (_1.traverse) (examName . entityVal) <$> view _userExams)
+                  <*> (over traverse (examName . entityVal) <$> view _userExams)
             , dbtCsvName = unpack csvName
             , dbtCsvNoExportData = Nothing
             , dbtCsvHeader = return . Vector.filter csvColumns' . flip (userTableCsvHeader showSex) tutorials . fromMaybe def
+            , dbtCsvExampleData = Nothing
             }
           where
             userNote = runMaybeT $ do
@@ -432,9 +515,13 @@ courseUserDeregisterForm cid = wFormToAForm $ do
   allocated <- liftHandler . runDB . E.selectExists . E.from $ \participant ->
     E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid
          E.&&. E.not_ (E.isNothing $ participant E.^. CourseParticipantAllocated)
+         E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
   if | allocated -> do
          wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip
-         fmap CourseUserDeregisterData <$> optionalActionW (areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
+         let selfImposedForm = (,)
+               <$> apreq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing
+               <*> apopt checkBoxField (fslI MsgCourseDeregistrationAllocationNoShow & setTooltip MsgCourseDeregistrationAllocationNoShowTip) Nothing
+         fmap CourseUserDeregisterData <$> optionalActionW selfImposedForm (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
      | otherwise -> pure . pure $ CourseUserDeregisterData Nothing
 
 getCUsersR, postCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
@@ -445,6 +532,16 @@ postCUsersR tid ssh csh = do
     mayRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
     ent@(Entity cid _) <- getBy404 $ TermSchoolCourseShort tid ssh csh
     hasTutorials <- exists [TutorialCourse ==. cid]
+    examOccurrencesPerExam <- E.select . E.from $ \(exam `E.LeftOuterJoin` examOccurrence) -> do
+      E.on $ E.just (exam E.^. ExamId) E.==. examOccurrence E.?. ExamOccurrenceExam
+      E.where_ $ exam E.^. ExamCourse E.==. E.val cid
+      return (exam, examOccurrence)
+    hasSubmissionGroups <- E.selectExists . E.from $ \(submissionGroup `E.InnerJoin` submissionGroupUser `E.InnerJoin` courseParticipant) -> do
+      E.on $ courseParticipant E.^. CourseParticipantUser E.==. submissionGroupUser E.^. SubmissionGroupUserUser
+       E.&&. courseParticipant E.^. CourseParticipantCourse E.==. submissionGroup E.^. SubmissionGroupCourse
+      E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+      E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cid
+    let exams = nubOn entityKey $ examOccurrencesPerExam ^.. folded . _1
     let colChoices  = mconcat $ catMaybes
           [ pure $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
           , pure $ colUserNameLink (CourseR tid ssh csh . CUserR)
@@ -454,24 +551,56 @@ postCUsersR tid ssh csh = do
           , pure $ colUserDegreeShort
           , pure $ colUserField
           , pure $ colUserSemester
+          , guardOn hasSubmissionGroups colUserSubmissionGroup
           , guardOn hasTutorials $ colUserTutorials tid ssh csh
-          , pure $ sortable (Just "registration") (i18nCell MsgRegisteredSince) (dateCell . view _userTableRegistration)
+          , guardOn hasExams $ colUserExams tid ssh csh
+          , pure $ sortable (Just "registration") (i18nCell MsgRegisteredSince) (maybe mempty dateCell . preview (_Just . _userTableRegistration) . assertM' (has $ _userTableParticipant . _entityVal . _courseParticipantState . _CourseParticipantActive))
+          , pure $ sortable (Just "state") (i18nCell MsgCourseUserState) (i18nCell . view (_userTableParticipant . _entityVal . _courseParticipantState))
           , pure $ colUserComment tid ssh csh
           ]
         psValidator = def & defaultSortingByName
-        acts = mconcat
+                          & defaultFilter (singletonMap "active" [toPathPiece True])
-          [ singletonMap CourseUserSendMail $ pure CourseUserSendMailData
+        hasExams = not $ null exams
-          , singletonMap CourseUserRegisterTutorial $ CourseUserRegisterTutorialData <$>
+        examOccActs :: Map ExamId (AForm Handler (ExamId, Maybe ExamOccurrenceId))
-            apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersistCryptoId [TutorialCourse ==. cid] [Asc TutorialName] tutorialName)
+        examOccActs = examOccurrencesPerExam
-                  (fslI MsgCourseTutorial)
+          & (map (bimap entityKey hoistMaybe)) 
-                  Nothing
+          & Map.fromListWith (<>)
-          , if
+          & imap (\k v -> case v of
-              | mayRegister
+            [] -> pure (k, Nothing)
-                -> singletonMap CourseUserDeregister $ courseUserDeregisterForm cid
+            _  -> (k,) <$> aopt (selectField' (Just $ SomeMessage MsgExamNoOccurrence) $ examOccOpts v) (fslI MsgExamOccurrence) (Just Nothing)
-              | otherwise
+            )
-                -> mempty
+          where
+            examOccOpts :: [Entity ExamOccurrence] -> Handler (OptionList ExamOccurrenceId)
+            examOccOpts examOccs = fmap mkOptionList . forM examOccs $ \Entity{..} -> do
+              optionExternalValue' <- encrypt entityKey :: Handler CryptoUUIDExamOccurrence
+              let
+                optionExternalValue = toPathPiece optionExternalValue'
+                optionInternalValue = entityKey
+                optionDisplay       = CI.original $ examOccurrenceName entityVal
+              return Option{..}
+        examActs :: Handler (OptionList ExamId)
+        examActs = fmap mkOptionList . forM exams $ \Entity{..} -> do
+          optionExternalValue' <- encrypt entityKey :: Handler CryptoUUIDExam
+          let
+            optionExternalValue = toPathPiece optionExternalValue'
+            optionInternalValue = entityKey
+            optionDisplay       = CI.original $ examName entityVal
+          return Option{..}
+        submissionGroupOpts = optionsPersist [SubmissionGroupCourse ==. cid] [Asc SubmissionGroupName] submissionGroupName <&> fmap (submissionGroupName . entityVal)
+        acts = mconcat $ catMaybes
+          [ pure . singletonMap CourseUserSendMail $ pure CourseUserSendMailData
+          , pure . singletonMap CourseUserRegisterTutorial $ CourseUserRegisterTutorialData
+              <$> apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersistCryptoId [TutorialCourse ==. cid] [Asc TutorialName] tutorialName)
+                        (fslI MsgCourseTutorial)
+                        Nothing
+          , pure . singletonMap CourseUserRegisterExam $ CourseUserRegisterExamData <$>
+              multiActionAOpts examOccActs examActs (fslI MsgCourseExam) Nothing
+          , pure . singletonMap CourseUserSetSubmissionGroup $ CourseUserSetSubmissionGroupData . assertM (not . Text.null . CI.original)
+              <$> aopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing
+          , guardOn mayRegister . singletonMap CourseUserDeregister $ courseUserDeregisterForm cid
+          , guardOn mayRegister . singletonMap CourseUserReRegister $ pure CourseUserReRegisterData
           ]
-    numParticipants <- count [CourseParticipantCourse ==. cid]
+    numParticipants <- count [CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive]
     table <- makeCourseUserTable cid acts (const E.true) colChoices psValidator (Just $ const True)
     return (ent, numParticipants, table)
   formResult participantRes $ \case
@@ -481,12 +610,23 @@ postCUsersR tid ssh csh = do
     (CourseUserDeregisterData{..}, selectedUsers) -> do
         Sum nrDel <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> fmap (maybe mempty Sum) . runMaybeT $ do
           now <- liftIO getCurrentTime
-          Entity _ CourseParticipant{..} <- MaybeT . getBy $ UniqueParticipant uid cid
+          Entity _ CourseParticipant{..} <- MaybeT . fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
           lift $ deregisterParticipant courseParticipantUser courseParticipantCourse
-          case deregisterReason of
+          case deregisterSelfImposed of
-            Just reason
+            Just (reason, noShow)
-              | is _Just courseParticipantAllocated ->
+              | is _Just courseParticipantAllocated -> lift $ do
-                  lift . insert_ $ AllocationDeregister uid (Just cid) now (Just reason)
+                  insert_ $ AllocationDeregister uid (Just cid) now (Just reason)
+                  updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
+                  let recordNoShow eId = do
+                        didRecord <- is _Just <$> insertUnique ExamResult
+                          { examResultExam = eId
+                          , examResultUser = uid
+                          , examResultResult = ExamNoShow
+                          , examResultLastChanged = now
+                          }
+                        when didRecord $
+                          audit $ TransactionExamResultEdit eId uid
+                  when noShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
             _other -> return ()
           return 1
         addMessageI Success $ MsgCourseUsersDeregistered nrDel
@@ -496,6 +636,52 @@ postCUsersR tid ssh csh = do
           void . insertUnique . TutorialParticipant registerTutorial
         addMessageI Success . MsgCourseUsersTutorialRegistered . fromIntegral $ Set.size selectedUsers
         redirect $ CourseR tid ssh csh CUsersR
+    (CourseUserRegisterExamData{..}, selectedUsers) -> do
+        Sum nrReg <- fmap mconcat . runDB . forM (Set.toList selectedUsers) $ \uid -> maybeT (return mempty) $ do
+          guardM . lift $ exists [ CourseParticipantUser ==. uid, CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive ]
+          now <- liftIO getCurrentTime
+          let (exam, mOccurrence) = registerExam
+          mExamReg <- lift $ insertUnique ExamRegistration
+            { examRegistrationExam       = exam
+            , examRegistrationUser       = uid
+            , examRegistrationOccurrence = mOccurrence
+            , examRegistrationTime       = now
+            }
+          case mExamReg of
+            Just _ -> do
+              lift . audit $ TransactionExamRegister exam uid
+              return 1
+            Nothing ->
+              return mempty
+        addMessageI Success $ MsgCourseUsersExamRegistered nrReg
+        redirect $ CourseR tid ssh csh CUsersR
+    (CourseUserSetSubmissionGroupData{..}, selectedUsers) -> do
+      nrSet <- runDB $ setUsersSubmissionGroup cid selectedUsers setSubmissionGroup
+
+      case setSubmissionGroup of
+        Nothing -> addMessageI Success $ MsgCourseUsersSubmissionGroupUnset  nrSet
+        Just _  -> addMessageI Success $ MsgCourseUsersSubmissionGroupSetNew nrSet
+
+      redirect $ CourseR tid ssh csh CUsersR
+    (CourseUserReRegisterData, selectedUsers) -> do
+      now <- liftIO getCurrentTime
+      Sum nrSet <- runDB . flip foldMapM selectedUsers $ \uid -> maybeT (return mempty) $ do
+        didUpdate <- lift $ updateWhereCount
+          [ CourseParticipantUser ==. uid
+          , CourseParticipantCourse ==. cid
+          , CourseParticipantState !=. CourseParticipantActive
+          ]
+          [ CourseParticipantState =. CourseParticipantActive
+          , CourseParticipantRegistration =. now
+          , CourseParticipantAllocated =. Nothing 
+          ]
+        guard $ didUpdate > 0
+        lift $ deleteWhere [ AllocationDeregisterCourse ==. Just cid, AllocationDeregisterUser ==. uid ]
+        lift . audit $ TransactionCourseParticipantEdit cid uid
+        return $ Sum didUpdate
+      addMessageI Success $ MsgCourseUsersStateSet nrSet
+      redirect $ CourseR tid ssh csh CUsersR
+
   let headingLong  = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{tid}|]
       headingShort = prependCourseTitle tid ssh csh MsgCourseMembers
   siteLayout headingLong $ do

src/Handler/Exam/AddUser.hs

@@ -127,7 +127,7 @@ postEAddUserR tid ssh csh examn = do
       whenM (lift . lift . existsBy $ UniqueExamRegistration eid uid) $
         throwError $ mempty { aurAlreadyRegistered = pure userEmail }
 
-      whenM (lift . lift . existsBy $ UniqueParticipant uid cid) $ do
+      whenM (lift . lift $ exists [ CourseParticipantCourse ==. cid, CourseParticipantUser ==. uid, CourseParticipantState ==. CourseParticipantActive ]) $ do
         lift $ lift examRegister
         throwError $ mempty { aurSuccess = pure userEmail }
 
@@ -142,13 +142,20 @@ postEAddUserR tid ssh csh examn = do
             | [f] <- features = Just f
             | otherwise       = Nothing
 
-      lift . lift . insert_ $ CourseParticipant
+      lift . lift . void $ upsert
-        { courseParticipantCourse = cid
+        CourseParticipant
-        , courseParticipantUser = uid
+          { courseParticipantCourse = cid
-        , courseParticipantRegistration = now
+          , courseParticipantUser = uid
-        , courseParticipantAllocated = Nothing
+          , courseParticipantRegistration = now
-        , ..
+          , courseParticipantAllocated = Nothing
-        }
+          , courseParticipantState = CourseParticipantActive
+          , ..
+          }
+        [ CourseParticipantRegistration =. now
+        , CourseParticipantAllocated =. Nothing
+        , CourseParticipantField =. courseParticipantField
+        , CourseParticipantState =. CourseParticipantActive
+        ]
       lift . lift . audit $ TransactionCourseParticipantEdit cid uid
       lift . lift . queueDBJob . JobQueueNotification $ NotificationCourseRegistered uid cid
       lift $ lift examRegister

src/Handler/Exam/CorrectorInvite.hs

@@ -16,6 +16,8 @@ import Text.Hamlet (ihamlet)
 
 import Data.Aeson hiding (Result(..))
 
+import qualified Data.HashSet as HashSet
+
   
 instance IsInvitableJunction ExamCorrector where
   type InvitationFor ExamCorrector = Exam
@@ -67,7 +69,7 @@ examCorrectorInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamCorrectorInviteHeading examName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamCorrectorInviteExplanation}|]
     invitationTokenConfig _ _ = do
-      itAuthority <- Right <$> liftHandler requireAuthId
+      itAuthority <- HashSet.singleton . Right <$> liftHandler requireAuthId
       return $ InvitationTokenConfig itAuthority Nothing Nothing Nothing
     invitationRestriction _ _ = return Authorized
     invitationForm _ _ _ = pure (JunctionExamCorrector, ())

src/Handler/Exam/Form.hs

@@ -339,7 +339,7 @@ validateExam = do
   guardValidation MsgExamStartMustBeAfterPublishOccurrenceAssignments      . fromMaybe True $ (>=) <$> efStart <*> efPublishOccurrenceAssignments
   guardValidation MsgExamEndMustBeAfterStart                               $ NTop efEnd                          >= NTop efStart
   guardValidation MsgExamFinishedMustBeAfterEnd                            . fromMaybe True $ (>=) <$> efFinished <*> efEnd
-  guardValidation MsgExamFinishedMustBeAfterStart                          $ NTop efFinished                     >= NTop efStart
+  guardValidation MsgExamFinishedMustBeAfterStart                          . fromMaybe True $ (>=) <$> efFinished <*> efStart
 
   forM_ efOccurrences $ \ExamOccurrenceForm{..} -> do
     guardValidation (MsgExamOccurrenceEndMustBeAfterStart eofName)       $ NTop eofEnd >= NTop (Just eofStart)

src/Handler/Exam/List.hs

@@ -1,5 +1,6 @@
 module Handler.Exam.List
-  ( getCExamListR
+  ( mkExamTable
+  , getCExamListR
   ) where
 
 import Import
@@ -9,12 +10,16 @@ import Handler.Utils
 import qualified Data.Map as Map
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
 
 
-getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+mkExamTable :: Entity Course -> DB (Any, Widget)
-getCExamListR tid ssh csh = do
+mkExamTable (Entity cid Course{..}) = do
-  Entity cid Course{..} <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
+  let tid = courseTerm
+      ssh = courseSchool
+      csh = courseShorthand
   now <- liftIO getCurrentTime
+  mbAid <- maybeAuthId
   mayCreate <- hasWriteAccessTo $ CourseR tid ssh csh CExamNewR
 
   let
@@ -24,15 +29,22 @@ getCExamListR tid ssh csh = do
           E.where_ $ exam E.^. ExamCourse E.==. E.val cid
           return exam
         dbtRowKey = (E.^. ExamId)
-        dbtProj x@DBRow{ dbrOutput = Entity _ Exam{..} } = do
+        dbtProj = return
-          guardM . hasReadAccessTo $ CExamR tid ssh csh examName EShowR
-          return x
         dbtColonnade = dbColonnade . mconcat $ catMaybes
-          [ Just . sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> anchorCell (CExamR tid ssh csh examName EShowR) examName
+          [ Just . sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> indicatorCell <> anchorCell (CExamR tid ssh csh examName EShowR) examName
           , (<$ guard mayCreate) . sortable (Just "visible") (i18nCell MsgExamVisibleFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty (dateTimeCellVisible now) examVisibleFrom
           , Just . sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom
           , Just . sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo
           , Just . sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart
+          , Just . sortable (Just "registered") (i18nCell MsgExamRegistration ) $ \DBRow{ dbrOutput = Entity eId Exam{..} } -> sqlCell $ do
+              mayRegister <- (== Authorized) <$> evalAccessDB (CExamR tid ssh csh examName ERegisterR) True
+              isRegistered <- case mbAid of
+                Nothing  -> return False
+                Just uid -> existsBy $ UniqueExamRegistration eId uid
+              let label   = bool MsgExamNotRegistered MsgExamRegistered isRegistered
+                  examUrl = CExamR tid ssh csh examName EShowR
+              if | mayRegister -> return $ simpleLinkI (SomeMessage label) examUrl
+                 | otherwise   -> return [whamlet|_{label}|]
           ]
         dbtSorting = Map.fromList
           [ ("name", SortColumn $ \exam -> exam E.^. ExamName )
@@ -40,8 +52,18 @@ getCExamListR tid ssh csh = do
           , ("register-from", SortColumn $ \exam -> exam E.^. ExamRegisterFrom )
           , ("register-to", SortColumn $ \exam -> exam E.^. ExamRegisterTo )
           , ("visible", SortColumn $ \exam -> exam E.^. ExamVisibleFrom )
+          , ("registered", SortColumn $ \exam ->
+              case mbAid of
+                Nothing -> E.false
+                Just uid ->
+                  E.exists $ E.from $ \reg -> do
+                    E.where_ $ reg E.^. ExamRegistrationUser E.==. E.val uid
+                    E.where_ $ reg E.^. ExamRegistrationExam E.==. exam E.^. ExamId
+            )
           ]
-        dbtFilter = Map.empty
+        dbtFilter = singletonMap "may-read" . FilterProjected $
+          \(Any b) DBRow{ dbrOutput = Entity _ Exam{..} }
+           -> (== b) <$> hasReadAccessTo (CExamR tid ssh csh examName EShowR) :: DB Bool
         dbtFilterUI = const mempty
         dbtStyle = def
         dbtParams = def
@@ -52,7 +74,17 @@ getCExamListR tid ssh csh = do
 
     examDBTableValidator = def
       & defaultSorting [SortAscBy "time"]
-  ((), examTable) <- runDB $ dbTable examDBTableValidator examDBTable
+      & forceFilter "may-read" (Any True)
+  
+  dbTable examDBTableValidator examDBTable
+
+
+getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getCExamListR tid ssh csh = do
+  (Entity _ Course{..}, examTable) <- runDB $ do
+    c <- getBy404 $ TermSchoolCourseShort tid ssh csh
+    (_, examTable) <- mkExamTable c
+    return (c, examTable)
 
   siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamsHeading) $ do
     setTitleI $ prependCourseTitle tid ssh csh MsgExamsHeading

src/Handler/Exam/New.hs

@@ -12,6 +12,8 @@ import Handler.Utils
 import Handler.Utils.Invitations
 
 import Jobs.Queue
+  
+import qualified Data.Conduit.Combinators as C
 
 
 getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
@@ -26,6 +28,8 @@ postCExamNewR tid ssh csh = do
 
   formResult newExamResult $ \ExamForm{..} -> do
     insertRes <- runDBJobs $ do
+      now <- liftIO getCurrentTime
+      
       insertRes <- insertUnique Exam
         { examName                         = efName
         , examCourse                       = cid
@@ -75,6 +79,18 @@ postCExamNewR tid ssh csh = do
                     , examCorrectorUser <- adds
                     ]
         sinkInvitationsF examCorrectorInvitationConfig $ map (, examid, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
+
+        let recordNoShow (Entity _ CourseParticipant{..}) = do
+              didRecord <- is _Just <$> insertUnique ExamResult
+                { examResultExam = examid
+                , examResultUser = courseParticipantUser
+                , examResultResult = ExamNoShow
+                , examResultLastChanged = now
+                }
+              when didRecord $
+                audit $ TransactionExamResultEdit examid courseParticipantUser
+        runConduit $ selectSource [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantInactive True ] [] .| C.mapM_ recordNoShow
+        
       return insertRes
     case insertRes of
       Nothing -> addMessageI Error $ MsgExamNameTaken efName

src/Handler/Exam/RegistrationInvite.hs

@@ -20,6 +20,8 @@ import Text.Hamlet (ihamlet)
 import Data.Aeson hiding (Result(..))
 
 import Jobs.Queue
+
+import qualified Data.HashSet as HashSet
   
 
 instance IsInvitableJunction ExamRegistration where
@@ -77,7 +79,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
     invitationHeading (Entity _ Exam{..}) _ = return . SomeMessage $ MsgExamRegistrationInviteHeading examName
     invitationExplanation _ _ = return [ihamlet|_{SomeMessage MsgExamRegistrationInviteExplanation}|]
     invitationTokenConfig _ (InvDBDataExamRegistration{..}, _) = do
-      itAuthority <- Right <$> liftHandler requireAuthId
+      itAuthority <- HashSet.singleton . Right <$> liftHandler requireAuthId
       let itExpiresAt = Just $ Just invDBExamRegistrationDeadline
           itAddAuth
             | not invDBExamRegistrationCourseRegister
@@ -88,7 +90,7 @@ examRegistrationInvitationConfig = InvitationConfig{..}
       return InvitationTokenConfig{..}
     invitationRestriction _ _ = return Authorized
     invitationForm (Entity _ Exam{..}) (InvDBDataExamRegistration{..}, _) uid = hoistAForm liftHandler . wFormToAForm $ do
-      isRegistered <- fmap (is _Just) . liftHandler . runDB . getBy $ UniqueParticipant uid examCourse
+      isRegistered <- fmap (is _Just) . liftHandler . runDB . fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive). getBy $ UniqueParticipant uid examCourse
       now <- liftIO getCurrentTime
 
       case (isRegistered, invDBExamRegistrationCourseRegister) of
@@ -99,7 +101,13 @@ examRegistrationInvitationConfig = InvitationConfig{..}
         (True , _    ) -> return $ pure (JunctionExamRegistration invDBExamRegistrationOccurrence now, Nothing) 
     invitationInsertHook _ (Entity eid Exam{..}) _ ExamRegistration{..} mField act = do
       whenIsJust mField $ \cpField -> do
-        insert_ $ CourseParticipant examCourse examRegistrationUser examRegistrationTime cpField Nothing
+        void $ upsert
+          (CourseParticipant examCourse examRegistrationUser examRegistrationTime cpField Nothing CourseParticipantActive)
+          [ CourseParticipantRegistration =. examRegistrationTime
+          , CourseParticipantField =. cpField
+          , CourseParticipantAllocated =. Nothing
+          , CourseParticipantState =. CourseParticipantActive
+          ]
         queueDBJob . JobQueueNotification $ NotificationCourseRegistered examRegistrationUser examCourse
         audit $ TransactionCourseParticipantEdit examCourse examRegistrationUser
       

src/Handler/Exam/Users.hs

@@ -165,7 +165,7 @@ resultCourseNote = _dbrOutput . _10 . _Just
 
 
 resultAutomaticExamBonus :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData Points
-resultAutomaticExamBonus exam examBonus' = resultUser . _entityKey . folding (\uid -> examResultBonus <$> examBonusRule exam <*> pure (examBonusPossible uid examBonus') <*> pure (examBonusAchieved uid examBonus'))
+resultAutomaticExamBonus exam examBonus' = resultUser . _entityKey . folding (\uid -> join $ examResultBonus <$> examBonusRule exam <*> pure (examBonusPossible uid examBonus') <*> pure (examBonusAchieved uid examBonus'))
 
 resultAutomaticExamResult :: Exam -> Map UserId SheetTypeSummary -> Fold ExamUserTableData ExamResultPassedGrade
 resultAutomaticExamResult exam@Exam{..} examBonus' = folding . runReader $ do
@@ -471,6 +471,7 @@ postEUsersR tid ssh csh examn = do
               E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
               E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
                E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
+               E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
               E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
                E.&&. occurrence E.?. ExamOccurrenceId   E.==. examRegistration E.^. ExamRegistrationOccurrence
               E.on $ examRegistration E.^. ExamRegistrationUser E.==. user E.^. UserId
@@ -485,10 +486,10 @@ postEUsersR tid ssh csh examn = do
               <*> getExamParts
               <*> view _9
             where
-              getExamParts :: ReaderT _ (MaybeT (YesodDB UniWorX)) (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)))
+              getExamParts :: ReaderT _ DB (Map ExamPartId (ExamPart, Maybe (Entity ExamPartResult)))
               getExamParts = do
                 uid <- view $ _2 . _entityKey
-                rawResults <- lift . lift . E.select . E.from $ \(examPart `E.LeftOuterJoin` examPartResult) -> do
+                rawResults <- lift . E.select . E.from $ \(examPart `E.LeftOuterJoin` examPartResult) -> do
                   E.on $ examPartResult E.?. ExamPartResultExamPart E.==. E.just (examPart E.^. ExamPartId)
                    E.&&. examPartResult E.?. ExamPartResultUser     E.==. E.just (E.val uid)
                   E.where_ $ examPart E.^. ExamPartExam E.==. E.val eid
@@ -617,6 +618,7 @@ postEUsersR tid ssh csh examn = do
             , dbtCsvName         = unpack csvName
             , dbtCsvNoExportData = Just id
             , dbtCsvHeader       = const . return . examUserTableCsvHeader allBoni doBonus $ examParts ^.. folded . _entityVal . _examPartNumber
+            , dbtCsvExampleData = Nothing
             }
             where
               doEncode' = ExamUserTableCsv
@@ -757,13 +759,20 @@ postEUsersR tid ssh csh examn = do
                 C.mapM_ $ \case
                   ExamUserCsvCourseRegisterData{..} -> do
                     now <- liftIO getCurrentTime
-                    insert_ CourseParticipant
+                    void $ upsert
-                      { courseParticipantCourse = examCourse
+                      CourseParticipant
-                      , courseParticipantUser = examUserCsvActUser
+                        { courseParticipantCourse = examCourse
-                      , courseParticipantRegistration = now
+                        , courseParticipantUser = examUserCsvActUser
-                      , courseParticipantField = examUserCsvActCourseField
+                        , courseParticipantRegistration = now
-                      , courseParticipantAllocated = Nothing
+                        , courseParticipantField = examUserCsvActCourseField
-                      }
+                        , courseParticipantAllocated = Nothing
+                        , courseParticipantState = CourseParticipantActive
+                        }
+                      [ CourseParticipantRegistration =. now
+                      , CourseParticipantField =. examUserCsvActCourseField
+                      , CourseParticipantAllocated =. Nothing
+                      , CourseParticipantState =. CourseParticipantActive
+                      ]
                     queueDBJob . JobQueueNotification $ NotificationCourseRegistered examUserCsvActUser examCourse
                     audit $ TransactionCourseParticipantEdit examCourse examUserCsvActUser
                     insert_ ExamRegistration
@@ -970,7 +979,7 @@ postEUsersR tid ssh csh examn = do
                       , GuessUserFirstName <$> csvEUserFirstName
                       ]
                 pid <- maybe (throwM ExamUserCsvExceptionNoMatchingUser) return =<< guessUser criteria
-                (,) <$> existsBy (UniqueParticipant pid examCourse) <*> pure pid
+                (,) <$> exists [CourseParticipantCourse ==. examCourse, CourseParticipantUser ==. pid, CourseParticipantState ==. CourseParticipantActive] <*> pure pid
 
               lookupOccurrence :: ExamUserTableCsv -> DB (Maybe ExamOccurrenceId)
               lookupOccurrence ExamUserTableCsv{..} = $cachedHereBinary (CI.foldedCase <$> csvEUserOccurrence) . for csvEUserOccurrence $ \occName -> do

src/Handler/ExamOffice/Exam.hs

@@ -204,8 +204,8 @@ postEGradesR tid ssh csh examn = do
     userFunctions <- selectList [ UserFunctionUser ==. uid, UserFunctionFunction ==. SchoolExamOffice ] []
 
     let
-      participantLink :: MonadCrypto m => UserId -> m (SomeRoute UniWorX)
+      participantLink :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m (SomeRoute UniWorX)
-      participantLink partId = do
+      participantLink partId = liftHandler $ do
         cID <- encrypt partId
         return . SomeRoute . CourseR tid ssh csh $ CUserR cID
 
@@ -261,6 +261,7 @@ postEGradesR tid ssh csh examn = do
               E.on $ studyFeatures E.?. StudyFeaturesId E.==. E.joinV (courseParticipant E.?. CourseParticipantField)
               E.on $ courseParticipant E.?. CourseParticipantCourse E.==. E.just (E.val examCourse)
                E.&&. courseParticipant E.?. CourseParticipantUser E.==. E.just (user E.^. UserId)
+               E.&&. courseParticipant E.?. CourseParticipantState E.==. E.just (E.val CourseParticipantActive)
               E.on $ occurrence E.?. ExamOccurrenceExam E.==. E.just (E.val eid)
                E.&&. occurrence E.?. ExamOccurrenceId   E.==. E.joinV (examRegistration E.?. ExamRegistrationOccurrence)
               E.on $ examRegistration E.?. ExamRegistrationUser E.==. E.just (user E.^. UserId)
@@ -276,16 +277,16 @@ postEGradesR tid ssh csh examn = do
             return (examResult, user, occurrence, studyFeatures, studyDegree, studyField, examRegistration, isSynced)
           dbtRowKey = views queryExamResult (E.^. ExamResultId)
 
-          dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) ExamUserTableData
+          dbtProj :: DBRow _ -> DB ExamUserTableData
           dbtProj = runReaderT $ (asks . set _dbrOutput) <=< magnify _dbrOutput $
             (,,,,,,,,)
               <$> view _1 <*> view _2 <*> view _3 <*> view _4 <*> view _5 <*> view _6 <*> view _7 <*> view (_8 . _Value)
               <*> getSynchronised
             where
-              getSynchronised :: ReaderT _ (MaybeT (YesodDB UniWorX)) [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
+              getSynchronised :: ReaderT _ DB [(UserDisplayName, UserSurname, UTCTime, Set SchoolShorthand)]
               getSynchronised = do
                 resId <- view $ _1 . _entityKey
-                syncs <- lift . lift . E.select . E.from $ \(examOfficeResultSynced `E.InnerJoin` user) -> do
+                syncs <- lift . E.select . E.from $ \(examOfficeResultSynced `E.InnerJoin` user) -> do
                   E.on $ examOfficeResultSynced E.^. ExamOfficeResultSyncedOffice E.==. user E.^. UserId
                   E.where_ $ examOfficeResultSynced E.^. ExamOfficeResultSyncedResult E.==. E.val resId
                   return ( examOfficeResultSynced E.^. ExamOfficeResultSyncedOffice
@@ -412,6 +413,7 @@ postEGradesR tid ssh csh examn = do
             , dbtCsvName = unpack csvName
             , dbtCsvNoExportData = Nothing
             , dbtCsvHeader = const . return $ Csv.headerOrder (error "headerOrder" :: ExamUserTableCsv)
+            , dbtCsvExampleData = Nothing
             }
           dbtCsvDecode = Nothing