feat(link password time): application restore

CHANGELOG.md

@@ -2,6 +2,182 @@
 
 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.
 
+## [25.20.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.20.1...v25.20.2) (2021-08-16)
+
+
+### Bug Fixes
+
+* **submissions:** maintain anonymity ([0184a5f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0184a5fe3b1af635318fa0fa317e3497f24fbc90))
+
+## [25.20.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.20.0...v25.20.1) (2021-08-13)
+
+
+### Bug Fixes
+
+* **interval jobs:** avoid accumulation, reduce job size ([24491b4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/24491b446b870698564adb9718e868e082873539))
+* **jobs:** more general no queue same ([b1143cb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b1143cb12bea48d75a2453f92122edcfb4fe51f1))
+* **volatile-cluster-config:** fix pathpiece instance ([dcd5ddd](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/dcd5dddec82da359a2100360cfeb6845ed320821))
+
+## [25.20.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.19.3...v25.20.0) (2021-08-12)
+
+
+### Features
+
+* **submission-show:** display authorship statements ([cbd6d7d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cbd6d7d2b098f8e2c921fd7a56a458d62331d784))
+* **submissions:** display authorship statements ([7749238](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7749238e554b612a8bf69e6beb94efe3e5d02973))
+* **submissions:** display submittors more explicitly ([d2e2456](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d2e2456f6204245d933fb6abc87c44388ce3e339))
+
+## [25.19.3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.19.2...v25.19.3) (2021-08-02)
+
+
+### Bug Fixes
+
+* **submissions:** more precise feedback ([d151b6f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d151b6fc14e5b32d9f07923149923d5ab7ea4880))
+
+## [25.19.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.19.1...v25.19.2) (2021-07-30)
+
+
+### Bug Fixes
+
+* **jobs:** flush only partially for reliability ([59c7c17](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/59c7c1766588052383754b16e575347fa960ad6a))
+* **submissions:** allow user to resolve themself for auth'stmt' ([5bbb86a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5bbb86aa7750dd907f49cb3ba5daf2cee8485bae))
+* **submissions:** cascade delete to authorship statements ([fcce16d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fcce16d838e5cba3187a82a5762b831d7df54cd0))
+* **submissions:** don't leak info from corrected versions of files ([66f5e96](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/66f5e96eca4cbcb6cb092092b1b1b069ce30f159))
+
+## [25.19.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.19.0...v25.19.1) (2021-07-26)
+
+
+### Bug Fixes
+
+* build ([071df90](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/071df906da6c41afa226f944a90c2f294eeba243))
+* **workflows:** disabled warning for top workflows/instances ([17ed2fa](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/17ed2fad2230944c629c6a0c8d8181f6fec8983f))
+
+## [25.19.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.18.2...v25.19.0) (2021-07-26)
+
+
+### Features
+
+* **workflows:** replace pages with warning if turned off ([8634d20](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/8634d20e2ad2d3746cf7b6111b91db9e57e4863b))
+
+## [25.18.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.18.1...v25.18.2) (2021-07-21)
+
+
+### Bug Fixes
+
+* **arc:** actually invalidate ([ef4734e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ef4734ebb671d9ef19c284a4c5cc9412d6e62874))
+
+## [25.18.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.18.0...v25.18.1) (2021-07-21)
+
+
+### Bug Fixes
+
+* typo ([26c3a60](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/26c3a60592c02570ceeed42cc977ad223baa16ae))
+* **authorship-statements:** resolve exam-part to exam properly ([3a2d031](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3a2d031bb5f5b4d6e5df06f8ec82957a1bc81a72))
+
+## [25.18.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.17.1...v25.18.0) (2021-07-21)
+
+
+### Features
+
+* load shedding ([9df0686](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9df0686086ff7b64d401a2302edd2fe7636db111))
+
+## [25.17.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.17.0...v25.17.1) (2021-07-21)
+
+
+### Bug Fixes
+
+* build ([9fd95d1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/9fd95d181c498d460eaf30436ff110f7c1f9413e))
+
+## [25.17.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.16.0...v25.17.0) (2021-07-18)
+
+
+### Features
+
+* demand authorship statements ([34b3e6a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/34b3e6ae21b38a5b8389deade5deeb77b0981ead))
+* i18n form ([2d95f35](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/2d95f353c1209a4d3528c6aaf53c832bf5429a34))
+* show authorship statement requirement for sheet ([5e96982](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5e969825ad0c84c240b5c17b011dacbb63f4bfdf))
+* **exams:** basic required optional action for authorship statements ([5cc41ae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5cc41aeef94993a24538b2f88af1fb75625036a8))
+* **exams:** disable and set use-custom field according to school setting ([22dfd33](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/22dfd33aca9b8ad797c2617bbc656cf8276edf38))
+* **exams:** display school default in form ([abd68ac](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/abd68ac0322a34afb62c416b60965e87ee6f10c2))
+* **exams:** do form validation ([bf7b25c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bf7b25ca9e9d11df94b91f7483ee339cefd3e0c9))
+* **exams:** first do-nothing stub for exam-wide authorship statements ([0392297](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0392297ddbfccbb9a08e678696a9cedd1098121a))
+* **exams:** use template authorship statement settings if applicable ([57a259d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/57a259d8a2822ac1c593663e99f6e41163909c91))
+* **schools:** add school settings regarding authorship statements ([cb8e338](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cb8e3385889c0c4c13418bc69af091b9c8a3f22f))
+* **schools:** more school-wide configuration authorship statements ([960bd76](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/960bd76acafc9cd077b831b67a281eb7b20e703c))
+* **schools:** store school authorship statements as html ([09927ae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/09927ae14004f7a27f816ad874704969641dad83))
+* **sheets:** add required flag and definition ([541dd76](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/541dd7688ffa36be8a968f26f920507ed5aae646))
+* **sheets:** display authship req on SShowR ([44473b4](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/44473b45756c5df20e6a81927867de191cf70366))
+* **sheets:** eliminate authship statement required Bool ([0735c05](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0735c05a7489957ed500bac1c006f4ecfdab74f3))
+* **sheets:** fetch school statement as statement default ([a39a0d7](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a39a0d7c8763e158dae5750afac8a78bd953dcdf))
+* **sheets:** introduce sheet-specific statements for exam-unrelated sheets and as exam-statement overrides ([3f87f20](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3f87f20eb14e5db8a63c61885c4570689169ebed))
+
+
+### Bug Fixes
+
+* **exams:** better behaviour for optional statements wrt school default ([fe78377](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fe78377fae8af7766f9720628aebef599656ed2f))
+* **exams:** correctly treat school-mode optional as off by default ([ac86832](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ac86832b34a605e5d64d56ef08a871bf307347a8))
+* **exams:** fix form validation wrt non-empty statements ([0082135](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0082135c56b7fc0e5db3af6910f8365e12920c46))
+* **exams:** fixhance exam authship form section ([4109db6](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/4109db6f815fbb49c861177b3caecb98c2a963d8))
+* **exams:** prefill with school authship statement in optional mode ([0cd8f4c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0cd8f4c02f383f43b5e3ea059cd3acd38595ab56))
+* **exams:** remove deprecated/unnecessary form validation wrt. authship statements ([bf059a1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bf059a132094e53c3ef956582b5e13517e9c133d))
+* **exams:** set use-custom correctly if forced ([8bb6140](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/8bb61401a77f20fcb35aa05401bf16285aad1d93))
+* **schools:** fix schools form wrt. discouraged modes ([53a8f1b](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/53a8f1ba122466312947cdbdb49749a61acab37c))
+* **schools:** insert correct authorship statement definition for exam-unrelated sheets ([2272647](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/227264743e0e8d0acf76839300a034b4bb1bf2a6))
+* **schools:** perform authorship statement inserts ([579371c](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/579371cffd87c247805bf4ead8bc2c278269a5ee))
+* **schools:** rename messages ([0e62073](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/0e6207376043af8fe0929019e3c39f80bcfea9a6))
+* **schools:** switch authorship modes to required in form ([8fb49dd](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/8fb49dd602f4eb854b300b5b399206aa2fbca87b))
+* **schools:** use StoredMarkup instead of Html for authorship statement ([67c3016](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/67c30165ae90603e8a97ad2661d2bacb92e2e53f))
+* **sheet-show:** move message ([1d8a2ce](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/1d8a2cef60a688bd514d529f8e1230e462811f1e))
+* **sheets:** fixhance sheet authship form section ([7192cb5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/7192cb527c7f66c320308a80de9906a6edc6e9ec))
+
+## [25.16.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.3...v25.16.0) (2021-07-13)
+
+
+### Features
+
+* **personalised-sheet-files:** seeds ([cf67945](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cf679452928c14200e1eb3877987ee299fbf9f6f))
+
+## [25.15.3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.2...v25.15.3) (2021-07-08)
+
+
+### Bug Fixes
+
+* avoid subSelectForeign join issues ([576fccb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/576fccb5222a5dbd19db69f142a39b4155b7486d))
+
+## [25.15.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.1...v25.15.2) (2021-07-06)
+
+
+### Bug Fixes
+
+* **explained-selection-field:** support linebreak in titles ([627a2df](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/627a2df7adf41651e698d8cd9d632d066fc2f868))
+
+## [25.15.1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.15.0...v25.15.1) (2021-07-06)
+
+
+### Bug Fixes
+
+* **cache:** atomicity & workflow instance invalidations ([ef7fde9](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ef7fde937ebf1bc31e3706fba1da166bb82133c5))
+
+## [25.15.0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.14.2...v25.15.0) (2021-07-05)
+
+
+### Features
+
+* **course material:** auto vorschläge für materialtype ([decdda3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/decdda359d16cce429a7e7a07d4674840e5fe6af))
+* **course material:** first two filters ([90e4a62](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/90e4a620f0c1671ff332db1910c176e58ccbac06))
+* **course material:** materialDescription in progress ([89e9887](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/89e9887fe1112cbc21517e4b501ead33f5a969ba))
+* **course material:** materialdescription search implemented ([3a9622d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3a9622dfb8474d9f3764f5870197e317a96d9de3))
+* **course material:** merge-request suggestions ([dc5fc3f](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/dc5fc3f710363f0644c43866505e32095b41ce92))
+* **course material:** runDB für cid nur einmal ([c09acbb](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c09acbbf8a7b95176b3d52449b3b9d26e315ccd6))
+* **course material:** small empty-bug fixed ([d8b1f97](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/d8b1f9788c74ea5d7dc4f1f45432649d9601106a))
+* **workflows:** update instances from definitions ([32efdae](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/32efdae839b1a3e43ed4161d20e598964970f15e))
+
+
+### Bug Fixes
+
+* **workflows:** workflow-definition edit translations ([5c5cbad](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5c5cbaddf8b33f455ff18789806a3e0f9ac447ed))
+* typo course-assistant ([c7ce167](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c7ce1679de799285ec7a9a0a62c0a202b9078eb3))
+
 ## [25.14.2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v25.14.1...v25.14.2) (2021-06-28)
 
 

clean.sh

@@ -24,15 +24,15 @@ if [[ "${target}" != ".stack-work" ]]; then
 
   move-back() {
       if [[ -d .stack-work ]]; then
-          mv -v .stack-work "${target}"
+          mv -vT .stack-work "${target}"
       else
           mkdir -v "${target}"
       fi
-      [[ -d .stack-work-clean ]] && mv -v .stack-work-clean .stack-work
+      [[ -d .stack-work-clean ]] && mv -vT .stack-work-clean .stack-work
   }
 
-  mv -v .stack-work .stack-work-clean
+  mv -vT .stack-work .stack-work-clean
-  mv -v "${target}" .stack-work
+  mv -vT "${target}" .stack-work
   trap move-back EXIT
 fi
 

config/settings.yml

@@ -40,7 +40,7 @@ bearer-expiration: 604800
 bearer-encoding: HS256
 maximum-content-length: "_env:MAX_UPLOAD_SIZE:805306368"
 session-files-expire: 3600
-prune-unreferenced-files-within: 57600
+prune-unreferenced-files-within: 604801
 prune-unreferenced-files-interval: 3600
 keep-unreferenced-files: 86400
 health-check-interval:
@@ -288,3 +288,5 @@ file-source-prewarm:
 
 bot-mitigations:
   - only-logged-in-table-sorting
+
+volatile-cluster-settings-cache-time: 10

frontend/src/app.sass

@@ -103,8 +103,8 @@ body
 .emph
   font-style: italic
 
-a,
+a:not(.btn),
-a:visited
+a:visited:not(.btn)
   text-decoration: none
   font-weight: 600
   transition: color .2s ease, background-color .2s ease
@@ -275,6 +275,9 @@ button:not(.btn-link),
   display: grid
   grid: min-content / auto-flow max-content
 
+  > form
+    margin: 0 !important
+
   .buttongroup--inline
     display: inline-grid
 
@@ -387,6 +390,12 @@ input[type="button"].btn-info:not(.btn-link):hover,
   padding-right: 10px
   max-width: 300px
 
+  &.table__td--unlimited
+    max-width: unset
+
+  &.table__td--wide
+    max-width: 600px
+
 .table__td--number
   width: min-content
   padding-left: 0
@@ -409,6 +418,12 @@ input[type="button"].btn-info:not(.btn-link):hover,
   line-height: 1.4
   vertical-align: top
 
+  &.table__td--bottom
+    vertical-align: bottom
+
+  &.table__td--middle
+    vertical-align: middle
+
 .table__td--automatic
   font-style: oblique
   color: var(--color-fontsec)
@@ -462,6 +477,10 @@ input[type="button"].btn-info:not(.btn-link):hover,
   max-height: 200px
   overflow-y: auto
 
+  .table__td--unlimited &, .table__td--wide &
+    max-height: unset
+    overflow-y: unset
+
 .table--vertical
   th, .table__th
     background-color: transparent
@@ -548,15 +567,14 @@ ul.list--inline
 
 .deflist__dt
   font-weight: 600
+  font-size: 1.12em
+  margin-bottom: .6em
 
   .deflist__explanation
     color: var(--color-fontsec)
-    font-size: 0.9rem
+    font-size: 0.9em
 
 .deflist__dd
-  font-size: 18px
-  margin-bottom: 10px
-
   > p, > .div-p
     margin-top: 0
 
@@ -573,9 +591,13 @@ ul.list--inline
 
   .deflist__dt,
   .deflist__dd
-    padding: 12px 0
+    padding: .75em 0
     margin: 0
-    font-size: 16px
+    font-size: unset
+
+    .explanation &
+      padding-top: 0
+      padding-bottom: 0
 
     &:last-of-type
       border: 0
@@ -1672,3 +1694,46 @@ video
   & > video
     object-fit: contain
     flex-grow: 1
+
+.hr
+  height: 1px
+  width: 90%
+  margin: 0.5em auto
+  background-color: var(--color-grey)
+
+.authorship-statement
+  & > dt
+    font-weight: 600
+    color: var(--color-fontsec)
+    font-style: italic
+    font-size: .9rem
+
+  & > dd
+    margin-left: 1em
+
+    & + dt
+      margin-top: .5em
+
+.authorship-statement-accept__accept
+  margin-top: 1em
+  display: grid
+  grid-template-columns: 25px 1fr
+  grid-template-areas: 'checkbox label'
+
+.authorship-statement-accept__container
+  max-width: 600px
+  max-height: 25vh
+  overflow: auto
+
+.authorship-statement-accept__accept-checkbox
+  align-self: center
+  grid-area: checkbox
+
+.authorship-statement-accept__accept-label
+  grid-area: label
+  font-weight: 600
+
+.authorship-statement__id
+  font-size: .5em
+  font-family: var(--font-monospace)
+  color: var(--color-fontsec)

frontend/src/utils/form/form.sass

@@ -43,7 +43,7 @@ fieldset
     display: grid
     grid-gap: 0 7px
     grid-template-columns: 25px 1fr
-    grid-template-rows: 25px 1fr
+    grid-template-rows: minmax(25px, auto) 1fr
     grid-template-areas: 'radiobox title' '. explanation'
     margin: 5px
     width: calc(33.33% - 10px)

ghci.sh

@@ -16,13 +16,13 @@ unset HOST
 
 
 move-back() {
-    mv -v .stack-work .stack-work-ghci
+    mv -vT .stack-work .stack-work-ghci
-    [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work
+    [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work
 }
 
 if [[ -d .stack-work-ghci ]]; then
-    [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build
+    [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build
-    mv -v .stack-work-ghci .stack-work
+    mv -vT .stack-work-ghci .stack-work
     trap move-back EXIT
 fi
 

haddock.sh

@@ -5,13 +5,13 @@ set -e
 [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || :
 
 move-back() {
-    mv -v .stack-work .stack-work-doc
+    mv -vT .stack-work .stack-work-doc
-    [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work
+    [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work
 }
 
 if [[ -d .stack-work-doc ]]; then
-    [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build
+    [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build
-    mv -v .stack-work-doc .stack-work
+    mv -vT .stack-work-doc .stack-work
     trap move-back EXIT
 fi
 

hlint.sh

@@ -5,13 +5,13 @@ set -e
 [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || :
 
 move-back() {
-    mv -v .stack-work .stack-work-test
+    mv -vT .stack-work .stack-work-test
-    [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work
+    [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work
 }
 
 if [[ -d .stack-work-test ]]; then
-    [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build
+    [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build
-    mv -v .stack-work-test .stack-work
+    mv -vT .stack-work-test .stack-work
     trap move-back EXIT
 fi
 

hoogle.sh

@@ -5,13 +5,13 @@ set -e
 [ "${FLOCKER}" != "$0" ] && exec env FLOCKER="$0" flock -en .stack-work.lock "$0" "$@" || :
 
 move-back() {
-    mv -v .stack-work .stack-work-doc
+    mv -vT .stack-work .stack-work-doc
-    [[ -d .stack-work-build ]] && mv -v .stack-work-build .stack-work
+    [[ -d .stack-work-build ]] && mv -vT .stack-work-build .stack-work
 }
 
 if [[ -d .stack-work-doc ]]; then
-    [[ -d .stack-work ]] && mv -v .stack-work .stack-work-build
+    [[ -d .stack-work ]] && mv -vT .stack-work .stack-work-build
-    mv -v .stack-work-doc .stack-work
+    mv -vT .stack-work-doc .stack-work
     trap move-back EXIT
 fi
 

messages/uniworx/categories/authorization/de-de-formal.msg

@@ -58,6 +58,7 @@ UnauthorizedSubmissionRated: Diese Abgabe ist noch nicht korrigiert.
 UnauthorizedSubmissionCorrector: Sie sind nicht Korrektor:in für diese Abgabe.
 UnauthorizedUserSubmission: Nutzer:innen dürfen für dieses Übungsblatt keine Abgaben erstellen.
 UnauthorizedCorrectorSubmission: Korrektor:innen dürfen für dieses Übungsblatt keine Abgaben erstellen.
+UnauthorizedCorrectionAnonymous: Korrektur ist nicht anonymisiert.
 DeprecatedRoute: Diese Ansicht ist obsolet und könnte in Zukunft entfallen.
 UnfreeMaterials: Die Materialien für diese Veranstaltung sind nicht allgemein freigegeben.
 UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung

messages/uniworx/categories/authorization/en-eu.msg

@@ -58,6 +58,7 @@ UnauthorizedSubmissionRated: This submission is not yet marked.
 UnauthorizedSubmissionCorrector: You are no corrector for this submission.
 UnauthorizedUserSubmission: Users may not directly submit for this exercise sheet.
 UnauthorizedCorrectorSubmission: Correctors may not create submissions for this exercise sheet.
+UnauthorizedCorrectionAnonymous: Correction is not anonymised.
 DeprecatedRoute: This view is deprecated and will be removed.
 UnfreeMaterials: Course material are not publicly accessable.
 UnauthorizedWrite: You do not have the write permission necessary to perform this action
@@ -128,4 +129,4 @@ InvalidCredentialsADPasswordMustChange: Password needs to be changed
 InvalidCredentialsADAccountLockedOut: Account disabled by intruder detection
 FormFieldRequiredTip: Required fields
 FormFieldWorkflowDatasetTip: At least one of the marked fields must be filled
-LoginTitle: Athentication
+LoginTitle: Authentication

messages/uniworx/categories/courses/courses/de-de-formal.msg

@@ -242,9 +242,9 @@ CourseAllApplicationsArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{
 CourseLecInviteHeading courseName@Text: Einladung zum/zur Kursverwalter/Kursverwalterin für #{courseName}
 CourseLecInviteExplanation: Sie wurden eingeladen, Verwalter:in für einen Kurs zu sein.
 CourseUserHasPersonalisedSheetFilesFilter: Teilnehmer:in hat personalisierte Übungsblatt-Dateien für
-HeadingCourseMembers: Teilnehmer
+HeadingCourseMembers: Teilnehmer:innen
 
-CourseAssistant: Assitent
+CourseAssistant: Assistent:in
 CourseParticipantStateIsInactive: Teilnehmer:in ist nicht aktiv
 CourseParticipantStateIsActive: Teilnehmer:in ist aktiv
 CourseUserSendMail: Nachricht an Teilnehmer:in senden

messages/uniworx/categories/courses/exam/exam/de-de-formal.msg

@@ -312,3 +312,10 @@ ExamGradingPass: Bestanden/Nicht Bestanden
 ExamGradingGrades: Numerische Noten
 ExamGradingMixed: Gemischt
 ExamFinished: Ergebnisse sichtbar ab
+
+ExamAuthorshipStatementSection: Eigenständigkeitserklärung
+ExamAuthorshipStatementRequired: Eigenständigkeitserklärung für prüfungszugehörige Übungsblattabgaben einfordern?
+ExamAuthorshipStatementRequiredTip: Sollen für alle zu dieser Prüfung zugehörige Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren?
+ExamAuthorshipStatementRequiredForcedTip: Für dieses Institut ist vorgeschrieben, dass für alle zu diese Prüfung zugehörigen Übungsblätter die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung zu akzeptieren.
+ExamAuthorshipStatementContent: Eigenständigkeitserklärung
+ExamAuthorshipStatementContentForcedTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für prüfungsrelevante Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet. Für alle zu diese Prüfung zugehörigen Übungsblätter werden die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert, diese Eigenständigkeitserklärung zu akzeptieren.

messages/uniworx/categories/courses/exam/exam/en-eu.msg

@@ -310,3 +310,10 @@ ExamGradingPass: Passed/Failed
 ExamGradingGrades: Numeric grades
 ExamGradingMixed: Mixed
 ExamFinished: Results visible from
+
+ExamAuthorshipStatementSection: Statement of Authorship
+ExamAuthorshipStatementRequired: Require Statement of Authorship for exam-related exercise sheet submissions?
+ExamAuthorshipStatementRequiredTip: Should submittors (each group member in case of submission groups) be required to accept a Statement of Authorship for all exercise sheets related to this exam?
+ExamAuthorshipStatementRequiredForcedTip: This school enforces Statements of Authorship for all exam-related exercise sheets.
+ExamAuthorshipStatementContent: Statement of Authorship
+ExamAuthorshipStatementContentForcedTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-related sheets must be used. Custom statements are prohibited.

messages/uniworx/categories/courses/material/de-de-formal.msg

@@ -30,3 +30,5 @@ MaterialVideoDownload: Herunterladen
 MaterialFree: Kursmaterialien ohne Anmeldung zugänglich
 AccessibleSince: Verfügbar seit
 VisibleFrom: Veröffentlicht
+FilterMaterialNameSearch !ident-ok: Name
+FilterMaterialTypeAndDescriptionSearch: Art/Beschreibung

messages/uniworx/categories/courses/material/en-eu.msg

@@ -30,3 +30,5 @@ MaterialVideoDownload: Download
 MaterialFree: Course material is publicly available.
 AccessibleSince: Accessible since
 VisibleFrom: Published
+FilterMaterialNameSearch !ident-ok: Name
+FilterMaterialTypeAndDescriptionSearch: Type/description

messages/uniworx/categories/courses/sheet/de-de-formal.msg

@@ -42,6 +42,8 @@ SheetPersonalisedFilesAllowNonPersonalisedSubmission: Nicht-personalisierte Abga
 SheetPersonalisedFilesAllowNonPersonalisedSubmissionTip: Sollen auch Kursteilnehmer:innen abgeben dürfen, für die keine personalisierten Dateien hinterlegt wurden?
 SheetPersonalisedFilesDownloadTemplateHere: Sie können hier ein Vorlage-Archiv für die vom System erwartete Verzeichnisstruktur für personalisierte Übungsblatt-Dateien herunterladen:
 SheetPersonalisedFilesUsersList: Liste von Teilnehmern mit personalisierten Übungsblatt-Dateien
+SheetPersonalisedFilesMetaYAMLSeedComment: Dieser String wird in einem kryptographischen Verfahren aus Daten generiert, die Benutzer:in und Übungsblatt eindeutig identifizieren. Er ist geeignet als Seed für einen Pseudozufallsgenerator verwendet zu werden um personalisierte Dateien (teil-)zufällig zu erzeugen.
+SheetPersonalisedFilesMetaYAMLNoSeedComment: Damit genügend Informationen vorhanden sind um Anhand von Daten des/der Benutzer/Benutzerin an dieser Stelle einen String zu erzeugen, der als Seed für einen Pseudozufallsgenerator geeignet ist, muss das Übungsblatt zunächst in Uni2work angelegt werden.
 SheetActiveFromTip: Download der Aufgabenstellung und Abgabe erst ab diesem Datum möglich. Ohne Datum keine Abgabe und keine Herausgabe der Aufgabenstellung
 SheetActiveToTip: Abgabe nur bis zu diesem Datum möglich. Ohne Datum unbeschränkte Abgabe möglich (soweit gefordert).
 SheetHintFrom: Hinweis ab
@@ -150,4 +152,18 @@ SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{pas
 SheetGradingPassBinary: Bestanden/Nicht Bestanden
 SheetGradingPassAlways: Automatisch bestanden, sobald korrigiert
 
-
+SheetAuthorshipStatementSection: Eigenständigkeitserklärung
+SheetAuthorshipStatementRequired: Eigenständigkeitserklärung für Übungsblattabgaben einfordern?
+SheetAuthorshipStatementRequiredTip: Sollen die Abgebenden (bei Abgabegruppen jedes Gruppenmitglied) aufgefordert werden, eine Eigenständigkeitserklärung abzugeben?
+SheetAuthorshipStatementRequiredForcedTip: Für dieses Institut sind Eigenständigkeitserklärungen für nicht-prüfungszugehörige Übungsblätter vorgeschrieben.
+SheetAuthorshipStatementContent: Eigenständigkeitserklärung
+SheetAuthorshipStatementContentForcedTip: Für dieses Institut ist die institutsweit vorgegebene Eigenständigkeitserklärung für nicht-prüfungszugehörige Übungsblätter zu verwenden. Benutzerdefinierte Erklärungen sind nicht gestattet.
+SheetAuthorshipStatementContentOverridesExamTip: Gehört dieses Übungsblatt zu einer Prüfung mit einer prüfungsweit eingestellten Eigenständigkeitserklärung, so können Sie hier eine für dieses Übungsblatt abweichende Eigenständigkeitserklärung angeben.
+SheetAuthorshipStatementExamNone: Keine Prüfung
+SheetAuthorshipStatementExam: Zugeordnete Prüfung
+SheetAuthorshipStatementMode: Eigenständigkeitserklärung
+SheetAuthorshipStatementModeDisabled: Keine Eigenständigkeitserklärungen
+SheetAuthorshipStatementModeExam: Einstellung folgt Prüfung
+SheetAuthorshipStatementModeEnabled: Eigenständigkeitserklärungen fordern
+SheetShowAuthorshipStatementsRequired: Eigenständigkeitserklärungen
+SheetShowAuthorshipStatementsRequiredYes: Um eine Abgabe anzulegen muss eine Eigenständigkeitserklärung abgegeben werden

messages/uniworx/categories/courses/sheet/en-eu.msg

@@ -42,6 +42,8 @@ SheetPersonalisedFilesAllowNonPersonalisedSubmission: Allow non-personalised sub
 SheetPersonalisedFilesAllowNonPersonalisedSubmissionTip: Should course participants with no assigned personalised files be allowed to submit anyway?
 SheetPersonalisedFilesDownloadTemplateHere: You can download a template for a ZIP-archive of personalised sheet files with the structure that Uni2work expects here:
 SheetPersonalisedFilesUsersList: List of course participants who have personalised sheet files
+SheetPersonalisedFilesMetaYAMLSeedComment: This string was generated cryptographically from data uniquely identifying the user and exercise sheet. You can use it as a seed for a pseudorandom generator for generating (parts of) the personalised files.
+SheetPersonalisedFilesMetaYAMLNoSeedComment: There is not enough information available to generate a seed. You will have to create the exercise sheet in Uni2work first. Once seeds can be generated they will be generated cryptographically and you may use them to generate (parts of) the personalised files.
 SheetActiveFromTip: The exercise sheet's assignment will only be available for download and submission starting at this time. If left empty no submission or download of assignment is ever allowed
 SheetActiveToTip: Submission will only be possible until this time. If left empty submissions are allowed forever (if at all possible)
 SheetHintFrom: Hint from
@@ -149,4 +151,18 @@ SheetGradingPassPoints maxPoints passingPoints: Pass with #{passingPoints} of #{
 SheetGradingPassBinary: Pass/Fail
 SheetGradingPassAlways: Automatically passed when corrected
 
-
+SheetAuthorshipStatementSection: Statement of Authorship
+SheetAuthorshipStatementRequired: Require Statement of Authorship for submissions?
+SheetAuthorshipStatementRequiredTip: Should submittors (each group member in case of submission groups) be required to accept a Statement of Authorship?
+SheetAuthorshipStatementRequiredForcedTip: This school enforces Statements of Authorship for all exam-unrelated exercise sheets.
+SheetAuthorshipStatementContent: Statement of Authorship
+SheetAuthorshipStatementContentForcedTip: The settings of this school dictate that the school-wide Statement of Authorship for exam-unrelated sheets must be used. Custom statements are prohibited.
+SheetAuthorshipStatementContentOverridesExamTip: If this exercise sheet is related to an exam with an exam-wide Statement of Authorship set, a sheet-specific adaptation can be given here.
+SheetAuthorshipStatementExamNone: No Exam
+SheetAuthorshipStatementExam: Related exam
+SheetAuthorshipStatementMode: Statements of Authorship
+SheetAuthorshipStatementModeDisabled: No Statements of Authorship
+SheetAuthorshipStatementModeExam: Setting follows exam
+SheetAuthorshipStatementModeEnabled: Demand Statements of Authorship
+SheetShowAuthorshipStatementsRequired: Statements of Authorship
+SheetShowAuthorshipStatementsRequiredYes: To submit for this exercise sheet a Statement of Authorship is required

messages/uniworx/categories/courses/submission/de-de-formal.msg

@@ -60,6 +60,9 @@ NotAParticipant email@UserEmail tid@TermId csh@CourseShorthand: #{email} ist nic
 TooManyParticipants: Es wurden zu viele Mitabgebende angegeben
 SubmissionCreated: Abgabe erfolgreich angelegt
 SubmissionUpdated: Abgabe erfolgreich ersetzt
+SubmissionUsersUpdated: Liste von Abgebenden erfolgreich angepasst
+SubmissionUnchanged: Abgabe unverändert
+SubmissionUpdatedAuthorshipStatement: Eigenständigkeitserklärung erfolgreich aktualisiert
 FileCorrected: Korrigiert (Dateien)
 Corrected: Korrigiert
 HeadingSubmissionEditHead tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{tid}-#{ssh}-#{csh} #{sheetName}: Abgabe editieren/anlegen
@@ -193,3 +196,35 @@ SubmissionDoneAlways: Immer
 SheetGroupNoGroups: Keine Gruppenabgabe
 
 CorrDownloadVersion !ident-ok: Version
+
+SubmissionAuthorshipStatement: Eigenständigkeitserklärung
+SubmissionAuthorshipStatementTip: Um abgeben zu können, müssen Sie die vorgegebene Eigenständigkeitserklärung akzeptieren. Hierfür müssen Sie die Checkbox am Ende der Erklärung zu markieren.
+SubmissionLecturerAuthorshipStatement: Eigenständigkeitserklärung
+SubmissionLecturerAuthorshipStatementTip: Wenn Sie sich selbst als Mitabgebende/Mitabgebender eintragen müssen Sie eine Eigenständigkeitserklärung abgeben. Beachten Sie, dass Sie eine Eigenständigkeitserklärung nur für sich selbst abgeben können, nicht für etwaige andere Mitabgebende; falls Sie eine Eigenständigkeitserklärung abgeben, wird diese nur unter Ihrem Namen in Uni2work gespeichert.
+SubmissionLecturerAuthorshipStatementRequiredBecauseSubmittor: Da Sie sich selbst als Mitabgebende/Mitabgebender eingetragen haben, müssen Sie eine Eigenständigkeitserklärung abgeben.
+SubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements: Da für die Abgabe zu diesem Übungsblatt die Abgabe einer Eigenständigkeitserklärung vorausgesetzt wird, werden bekannte E-Mail Adressen bekannter Benutzer nicht aufgelöst. Mitabgebende müssen stattdessen per E-Mail eingeladen werden.
+
+SubmissionUserTable: Abgebende
+SubmissionUserDisplayName !ident-ok: Name
+SubmissionUserMatriculation: Matrikelnummer
+SubmissionUserEmail: E-Mail
+SubmissionUserAuthorshipStatementState: Eigenständigkeitserklärung
+
+SubmissionAuthorshipStatementStateExists: Vorhanden
+SubmissionAuthorshipStatementStateOldStatement: Unpassender Wortlaut
+SubmissionAuthorshipStatementStateMissing: Fehlt
+
+SubmissionTitle tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission !ident-ok: #{tid}-#{ssh}-#{csh} #{shn}: #{toPathPiece cID}
+SubmissionHeadingEdit tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe #{toPathPiece cID} editieren
+SubmissionHeadingShow tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe #{toPathPiece cID}
+SubmissionTitleNew tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe anlegen
+SubmissionHeadingNew tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: #{tid}-#{ssh}-#{csh} #{shn}: Abgabe anlegen
+
+SubmissionAuthorshipStatementsHeading tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Eigenständigkeitserklärungen #{toPathPiece cID}
+SubmissionAuthorshipStatementsTitle tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName cID@CryptoFileNameSubmission: #{tid}-#{ssh}-#{csh} #{shn}: Eigenständigkeitserklärungen #{toPathPiece cID}
+
+SubmissionColumnAuthorshipStatementTime: Zeitstempel
+SubmissionColumnAuthorshipStatementWording: Wortlaut
+SubmissionFilterAuthorshipStatementCurrent: Aktueller Wortlaut
+
+SubmissionNoUsers: Diese Abgabe hat keine assoziierten Benutzer!

messages/uniworx/categories/courses/submission/en-eu.msg

@@ -58,6 +58,9 @@ NotAParticipant email tid csh: #{email} is not a participant of #{tid}-#{csh}.
 TooManyParticipants: You have specified more than the allowed number of submittors.
 SubmissionCreated: Successfully created submission
 SubmissionUpdated: Successfully replaced submission
+SubmissionUsersUpdated: Successfully changed list of submittors
+SubmissionUnchanged: Submission unchanged
+SubmissionUpdatedAuthorshipStatement: Successfully updated Statement of Authorship
 FileCorrected: Marked (files)
 Corrected: Marked
 HeadingSubmissionEditHead tid ssh csh sheetName: #{tid}-#{ssh}-#{csh} #{sheetName}: Edit/Create submission
@@ -192,3 +195,35 @@ SubmissionDoneAlways: Always
 SheetGroupNoGroups: No group submission
 
 CorrDownloadVersion !ident-ok: Version
+
+SubmissionAuthorshipStatement: Statement of Authorship
+SubmissionAuthorshipStatementTip: To submit you have to accept the provided statement of authership. To do so you have to check the box at the end of the statement.
+SubmissionLecturerAuthorshipStatement: Statement of Authorship
+SubmissionLecturerAuthorshipStatementTip: If you enter yourself as a submittor you have to confirm the Statement of Authorship. Note that you can only confirm the Statement of Authorship for yourself. If you confirm it, it will be recorded only under your name.
+SubmissionLecturerAuthorshipStatementRequiredBecauseSubmittor: Since you have entered yourself as a submittor you have to confirm the Statement of Authorship.
+SubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements: Since Statements of Authorship are required to submit for this exercise sheet, e-mail addresses of known users are not resolved. Instead co-submittors will have to be invited via e-mail.
+
+SubmissionUserTable: Submittors
+SubmissionUserDisplayName: Name
+SubmissionUserMatriculation: Matriculation
+SubmissionUserEmail: Email
+SubmissionUserAuthorshipStatementState: Statement of Authorship
+
+SubmissionAuthorshipStatementStateExists: Exists
+SubmissionAuthorshipStatementStateOldStatement: Wrong wording
+SubmissionAuthorshipStatementStateMissing: Missing
+
+SubmissionTitle tid ssh csh shn cID !ident-ok: #{tid}-#{ssh}-#{csh} #{shn}: #{toPathPiece cID}
+SubmissionHeadingEdit tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Edit Submission #{toPathPiece cID}
+SubmissionHeadingShow tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Submission #{toPathPiece cID}
+SubmissionTitleNew tid ssh csh shn: #{tid}-#{ssh}-#{csh} #{shn}: Create Submission
+SubmissionHeadingNew tid ssh csh shn: #{tid}-#{ssh}-#{csh} #{shn}: Create Submission
+
+SubmissionAuthorshipStatementsHeading tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Authorship Statements #{toPathPiece cID}
+SubmissionAuthorshipStatementsTitle tid ssh csh shn cID: #{tid}-#{ssh}-#{csh} #{shn}: Authorship Statements #{toPathPiece cID}
+
+SubmissionColumnAuthorshipStatementTime: Timestamp
+SubmissionColumnAuthorshipStatementWording: Wording
+SubmissionFilterAuthorshipStatementCurrent: Current wording
+
+SubmissionNoUsers: This submission has no associated users!

messages/uniworx/categories/school/de-de-formal.msg

@@ -4,6 +4,8 @@ SchoolName !ident-ok: Name
 SchoolLdapOrganisations: Assoziierte LDAP-Fragmente
 SchoolLdapOrganisationsTip: Beim Login via LDAP werden dem Nutzer/der Nutzerin alle Institute zugeordnet deren assoziierte LDAP-Fragmente im Eintrag des Nutzer/der Nutzerin gefunden werden
 SchoolLdapOrganisationMissing: LDAP-Fragment wird benötigt
+
+SchoolExamSection: Prüfungen
 SchoolExamMinimumRegisterBeforeStart: Minimale Tage zwischen Anmeldebeginn und Termin für Prüfungen
 SchoolExamMinimumRegisterBeforeStartTip: Wenn angegeben werden Dozierende gezwungen Anmeldezeitraum und Prüfungstermin stets zusammen einzustellen.
 SchoolExamMinimumRegisterDuration: Minimale Anmeldedauer für Prüfungen
@@ -12,6 +14,7 @@ SchoolExamRequireModeForRegistration: Prüfungsmodus erforderlich für Anmeldung
 SchoolExamRequireModeForRegistrationTip: Sollen Dozierende gezwungen werden Prüfungsmodus und Anmeldefrist stets zusammen einzustellen?
 SchoolExamDiscouragedModes: Prüfungsmodi mit Warnung
 ExamCloseMode: Prüfungs-Abschluss
+
 SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst
 SchoolTitle ssh@SchoolId: Institut „#{ssh}“
 TitleSchoolNew: Neues Institut anlegen
@@ -22,3 +25,16 @@ SchoolEvaluation: Kursumfragenverwaltung
 SchoolExamOffice: Prüfungsverwaltung
 SchoolAllocation: Zentralanmeldungs-Administration 
 SchoolAdmin !ident-ok: Admin
+
+SchoolAuthorshipStatementSection: Eigenständigkeitserklärungen
+SchoolAuthorshipStatementSheetMode: Modus für nicht-prüfungszugehörige Übungsblattabgaben
+SchoolAuthorshipStatementSheetExamMode: Modus für prüfungszugehörige Übungsblattabgaben
+SchoolAuthorshipStatementModeNone: Keine Eigenständigkeitserklärung erlauben
+SchoolAuthorshipStatementModeOptional: Eigenständigkeitserklärung optional einforderbar
+SchoolAuthorshipStatementModeRequired: Eigenständigkeitserklärung immer erforderlich
+SchoolAuthorshipStatementSheetDefinition: Eigenständigkeitserklärung für nicht-prüfungszugehörige Übungsblattabgaben
+SchoolAuthorshipStatementSheetDefinitionTip: Bitte in sowohl deutscher als auch englischer Sprache angeben.
+SchoolAuthorshipStatementSheetExamDefinition: Eigenständigkeitserklärung für prüfungszugehörige Übungsblattabgaben
+SchoolAuthorshipStatementSheetExamDefinitionTip: Bitte in sowohl deutscher als auch englischer Sprache angeben.
+SchoolAuthorshipStatementSheetAllowOther: Abweichende Eigenständigkeitserklärungen für nicht-prüfungszugehörige Übungsblätter erlauben?
+SchoolAuthorshipStatementSheetExamAllowOther: Abweichende Eigenständigkeitserklärungen für prüfungszugehörige Übungsblätter erlauben?

messages/uniworx/categories/school/en-eu.msg

@@ -4,6 +4,8 @@ SchoolName: Name
 SchoolLdapOrganisations: Associated LDAP fragments
 SchoolLdapOrganisationsTip: When logging in users are associated with any departments whose associated LDAP fragments are found in the users LDAP entry
 SchoolLdapOrganisationMissing: LDAP-fragment is required
+
+SchoolExamSection: Exams
 SchoolExamMinimumRegisterBeforeStart: Minimum number of days between start of registration period and start of exams
 SchoolExamMinimumRegisterBeforeStartTip: If specified course administrators will be forced to specify the start of the registration period and the start of the exam at the same time.
 SchoolExamMinimumRegisterDuration: Minimum duration of registration period for exams
@@ -12,6 +14,7 @@ SchoolExamRequireModeForRegistration: Exam design required for registration
 SchoolExamRequireModeForRegistrationTip: Should course administrators be forced to fully specify their exam design when setting a registration period?
 SchoolExamDiscouragedModes: Exam designs to warn against
 ExamCloseMode: Exam closure
+
 SchoolUpdated ssh: Successfully edited #{ssh}
 SchoolTitle ssh: Department „#{ssh}“
 TitleSchoolNew: Create new department
@@ -22,3 +25,16 @@ SchoolLecturer: Lecturer
 SchoolEvaluation: Course evaluation
 SchoolExamOffice: Exam office
 SchoolAllocation: Administration of central allocations
+
+SchoolAuthorshipStatementSection: Statements of Authorship
+SchoolAuthorshipStatementSheetMode: Mode for exam-unrelated exercise sheet submissions
+SchoolAuthorshipStatementSheetExamMode: Mode for exam-related exercise sheet submissions
+SchoolAuthorshipStatementModeNone: No Statement of Authorship allowed
+SchoolAuthorshipStatementModeOptional: Statement of Authorship optionally activatable
+SchoolAuthorshipStatementModeRequired: Statement of Authorship always required
+SchoolAuthorshipStatementSheetDefinition: Statement of Authorship for exam-unrelated exercise sheets
+SchoolAuthorshipStatementSheetDefinitionTip: Please enter both german and english statements.
+SchoolAuthorshipStatementSheetExamDefinition: Statement of Authorship for exam-related exercise sheets
+SchoolAuthorshipStatementSheetExamDefinitionTip: Please enter both german and english statements.
+SchoolAuthorshipStatementSheetAllowOther: Allow adaptations for exam-unrelated exercise sheets?
+SchoolAuthorshipStatementSheetExamAllowOther: Allow adaptations for exam-related exercise sheets?

messages/uniworx/categories/settings/auth_settings/de-de-formal.msg

@@ -42,6 +42,7 @@ AuthTagPersonalisedSheetFiles: Nutzer:in verfügt über personalisierte Übungsb
 AuthTagRated: Korrektur ist bewertet
 AuthTagUserSubmissions: Abgaben erfolgen durch Kursteilnehmer:innen
 AuthTagCorrectorSubmissions: Abgaben erfolgen durch Korrektor:innen
+AuthTagCorrectionAnonymous: Korrektur ist anonymisiert
 AuthTagSelf: Nutzer:in greift nur auf eigene Daten zu
 AuthTagIsLDAP: Nutzer:in meldet sich mit Campus-Kennung an
 AuthTagIsPWHash: Nutzer:in meldet sich mit Uni2work-Kennung an

messages/uniworx/categories/settings/auth_settings/en-eu.msg

@@ -42,6 +42,7 @@ AuthTagPersonalisedSheetFiles: User has been assigned personalised sheet files
 AuthTagRated: Submission is marked
 AuthTagUserSubmissions: Submissions are made by course participants
 AuthTagCorrectorSubmissions: Submissions are registered by correctors
+AuthTagCorrectionAnonymous: Correction is anonymised
 AuthTagSelf: User is only accessing their only data
 AuthTagIsLDAP: User logs in using their campus account
 AuthTagIsPWHash: User logs in using their Uni2work-internal account

messages/uniworx/categories/workflows/de-de-formal.msg

@@ -55,14 +55,17 @@ WorkflowDescription: Beschreibung
 GlobalWorkflowInstancesHeading: Workflows (Systemweit)
 GlobalWorkflowInstancesTitle: Workflows (Systemweit)
 
-GlobalWorkflowInstanceInitiateHeading workflowInstanceTitle@Text: Worklow initiieren: #{workflowInstanceTitle}
+GlobalWorkflowInstanceInitiateHeading workflowInstanceTitle@Text: Workflow initiieren: #{workflowInstanceTitle}
-GlobalWorkflowInstanceInitiateTitle: Worklow initiieren
+GlobalWorkflowInstanceInitiateTitle: Workflow initiieren
 
 SchoolWorkflowInstancesHeading ssh@SchoolId !ident-ok: Workflows (#{ssh})
 SchoolWorkflowInstancesTitle ssh@SchoolId !ident-ok: Workflows (#{ssh})
 
-SchoolWorkflowInstanceInitiateHeading ssh@SchoolId workflowInstanceTitle@Text: Worklow initiieren: #{ssh}, #{workflowInstanceTitle}
+SchoolWorkflowInstanceInitiateHeading ssh@SchoolId workflowInstanceTitle@Text: Workflow initiieren: #{ssh}, #{workflowInstanceTitle}
-SchoolWorkflowInstanceInitiateTitle ssh@SchoolId: Worklow initiieren: #{ssh}
+SchoolWorkflowInstanceInitiateTitle ssh@SchoolId: Workflow initiieren: #{ssh}
+
+WorkflowInstanceInitiateHeadingDisabled: Workflow initiieren
+WorkflowInstanceInitiateTitleDisabled: Workflow initiieren
 
 WorkflowEdgeNumberedVariant edgeLabel@Text i@Natural: #{edgeLabel} (Variante #{i})
 WorkflowEdgeFormEdge: Aktion
@@ -120,12 +123,14 @@ GlobalWorkflowWorkflowWorkflowTitle workflowWorkflowId@CryptoFileNameWorkflowWor
 SchoolWorkflowWorkflowWorkflowHeading ssh@SchoolId workflowWorkflowId@CryptoFileNameWorkflowWorkflow !ident-ok: Workflow #{ssh}, #{toPathPiece workflowWorkflowId}
 SchoolWorkflowWorkflowWorkflowTitle ssh@SchoolId workflowWorkflowId@CryptoFileNameWorkflowWorkflow !ident-ok: Workflow #{ssh}, #{toPathPiece workflowWorkflowId}
 
-WorkflowWorkflowListScopeTitle rScope@Text: Laufende Workflows - #{rScope}
+WorkflowWorkflowListScopeTitle rScope@RouteWorkflowScope: Laufende Workflows - _{rScope}
-WorkflowWorkflowListScopeHeading rScope@Text: Laufende Workflows (#{rScope})
+WorkflowWorkflowListScopeHeading rScope@RouteWorkflowScope: Laufende Workflows (_{rScope})
 WorkflowWorkflowListInstanceTitle: Laufende Workflows für Instanz
 WorkflowWorkflowListInstanceHeading: Laufende Workflows für Instanz
-WorkflowWorkflowListNamedInstanceTitle rScope@Text wiTitle@Text: Laufende Workflows - #{rScope}, #{wiTitle}
+WorkflowWorkflowListNamedInstanceTitle rScope@RouteWorkflowScope wiTitle@Text: Laufende Workflows - _{rScope}, #{wiTitle}
-WorkflowWorkflowListNamedInstanceHeading rScope@Text wiTitle@Text: Laufende Workflows (#{rScope}, #{wiTitle})
+WorkflowWorkflowListNamedInstanceHeading rScope@RouteWorkflowScope wiTitle@Text: Laufende Workflows (_{rScope}, #{wiTitle})
+WorkflowWorkflowListNamedInstanceTitleDisabled rScope@RouteWorkflowScope: Laufende Workflows - _{rScope}
+WorkflowWorkflowListNamedInstanceHeadingDisabled rScope@RouteWorkflowScope: Laufende Workflows (_{rScope})
 WorkflowWorkflowListTopTitle: Laufende Workflows
 WorkflowWorkflowListTopHeading: Laufende Workflows
 AdminWorkflowWorkflowListTitle: Laufende Workflows
@@ -147,3 +152,12 @@ YAMLFieldDecodeFailure yamlFailure@String: Konnte YAML nicht parsen: #{yamlFailu
 WGFTextInput: Textfeld
 WGFFileUpload: Dateifeld
 WorkflowWorkflowListPersons: Beteiligte Benutzer
+
+BtnWorkflowInstanceUpdate !ident-ok: Update
+WorkflowInstanceUpdateNoActions: Keine Updates verfügbar
+WorkflowInstanceUpdateUpdatedGraph: Definitions-Update erfolgreich angewandt
+WorkflowInstanceUpdateUpdatedCategory: Kategorie-Update erfolgreich angewandt
+WorkflowInstanceUpdateDeletedDescriptionLanguage lang@Lang: Beschreibung/Titel in Sprache „#{lang}“ gelöscht
+WorkflowInstanceUpdateUpdatedDescriptionLanguage lang@Lang: Beschreibung/Titel-Update für Sprache „#{lang}“ angewandt
+
+WorkflowsDisabled: Workflows sind temporär deaktiviert.

messages/uniworx/categories/workflows/en-eu.msg

@@ -23,6 +23,9 @@ SchoolWorkflowInstancesTitle ssh: Workflows (#{ssh})
 SchoolWorkflowInstanceInitiateHeading ssh workflowInstanceTitle: Initiate workflow: #{ssh}, #{workflowInstanceTitle}
 SchoolWorkflowInstanceInitiateTitle ssh: Initiate workflow: #{ssh}
 
+WorkflowInstanceInitiateHeadingDisabled: Initiate Workflow
+WorkflowInstanceInitiateTitleDisabled: Initiate Workflow
+
 WorkflowEdgeNumberedVariant edgeLabel i: #{edgeLabel} (variant #{i})
 WorkflowEdgeFormEdge: Action
 WorkflowEdgeFormHiddenPayload i: Hidden dataset #{i}
@@ -79,12 +82,14 @@ GlobalWorkflowWorkflowWorkflowTitle workflowWorkflowId: Workflow #{toPathPiece w
 SchoolWorkflowWorkflowWorkflowHeading ssh workflowWorkflowId: Workflow #{ssh}, #{toPathPiece workflowWorkflowId}
 SchoolWorkflowWorkflowWorkflowTitle ssh workflowWorkflowId: Workflow #{ssh}, #{toPathPiece workflowWorkflowId}
 
-WorkflowWorkflowListScopeTitle rScope: Running workflows - #{rScope}
+WorkflowWorkflowListScopeTitle rScope: Running workflows - _{rScope}
-WorkflowWorkflowListScopeHeading rScope: Running workflows (#{rScope})
+WorkflowWorkflowListScopeHeading rScope: Running workflows (_{rScope})
 WorkflowWorkflowListInstanceTitle: Running workflows for an instance
 WorkflowWorkflowListInstanceHeading: Running workflows for an instance
-WorkflowWorkflowListNamedInstanceTitle rScope wiTitle: Running workflows - #{rScope}, #{wiTitle}
+WorkflowWorkflowListNamedInstanceTitle rScope wiTitle: Running workflows - _{rScope}, #{wiTitle}
-WorkflowWorkflowListNamedInstanceHeading rScope wiTitle: Running workflows (#{rScope}, #{wiTitle})
+WorkflowWorkflowListNamedInstanceHeading rScope wiTitle: Running workflows (_{rScope}, #{wiTitle})
+WorkflowWorkflowListNamedInstanceTitleDisabled rScope: Running Workflows - _{rScope}
+WorkflowWorkflowListNamedInstanceHeadingDisabled rScope: Running Workflows (_{rScope})
 WorkflowWorkflowListTopTitle: Running workflows
 WorkflowWorkflowListTopHeading: Running workflows
 AdminWorkflowWorkflowListTitle: Running workflows
@@ -147,3 +152,12 @@ YAMLFieldDecodeFailure yamlFailure: Could not parse YAML: #{yamlFailure}
 WGFTextInput: Text field
 WGFFileUpload: File field
 WorkflowWorkflowListPersons: Involved users
+
+BtnWorkflowInstanceUpdate: Update
+WorkflowInstanceUpdateNoActions: No updates available
+WorkflowInstanceUpdateUpdatedGraph: Successfully applied updated definition
+WorkflowInstanceUpdateUpdatedCategory: Successfully applied updated category
+WorkflowInstanceUpdateDeletedDescriptionLanguage lang: Successfully deleted description/title for language “#{lang}”
+WorkflowInstanceUpdateUpdatedDescriptionLanguage lang: Successfully applied updated description/title for language “#{lang}”
+
+WorkflowsDisabled: Workflows are temporarily disabled.

messages/uniworx/utils/authorship_statement/de-de-formal.msg

@@ -0,0 +1,2 @@
+AuthorshipStatementStatementIsRequired: Sie müssen die Eigenständigkeitserklärung als zutreffend bestätigen
+AuthorshipStatementAccept: Ich habe die obenstehende Eigenständigkeitserklärung gelesen und verstanden und erkläre hiermit, dass die obenstehenden Aussagen zutreffen.

messages/uniworx/utils/authorship_statement/en-eu.msg

@@ -0,0 +1,2 @@
+AuthorshipStatementStatementIsRequired: You have to confirm the Statement of Authorship as true and correct
+AuthorshipStatementAccept: I have read and understood the above Statement of Authorship and state that the above-mentioned statements are true and correct.

messages/uniworx/utils/handler_form/de-de-formal.msg

@@ -0,0 +1,3 @@
+I18nFormNoTranslations: (Noch) keine Übersetzungen
+I18nFormLanguageAlreadyExists lang@Lang: Die Sprache „#{lang}“ wurde bereits hinzugefügt.
+I18nFormLanguage: Sprache

messages/uniworx/utils/handler_form/en-eu.msg

@@ -0,0 +1,3 @@
+I18nFormLanguageAlreadyExists lang: Language “#{lang}” was already added.
+I18nFormLanguage: Language
+I18nFormNoTranslations: No translations (yet)

messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg

@@ -96,6 +96,7 @@ BreadcrumbWorkflowInstanceWorkflowList: Laufende Workflows
 BreadcrumbWorkflowInstanceInitiate: Workflow starten
 BreadcrumbWorkflowInstanceList !ident-ok: Workflows
 BreadcrumbWorkflowInstanceNew: Neuer Workflow
+BreadcrumbWorkflowInstanceUpdate !ident-ok: Update
 BreadcrumbWorkflowWorkflowList: Laufende Workflows
 BreadcrumbWorkflowWorkflow workflow@CryptoFileNameWorkflowWorkflow !ident-ok: #{toPathPiece workflow}
 BreadcrumbWorkflowWorkflowFiles: Dateien
@@ -186,3 +187,4 @@ BreadcrumbMessageList: Systemnachrichten
 BreadcrumbGlossary: Begriffsverzeichnis
 BreadcrumbLogin !ident-ok: Login
 BreadcrumbNews: Aktuell
+BreadcrumbSubmissionAuthorshipStatements: Eigenständigkeitserklärungen

messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg

@@ -96,6 +96,7 @@ BreadcrumbWorkflowInstanceWorkflowList: Running workflows
 BreadcrumbWorkflowInstanceInitiate: Start workflow
 BreadcrumbWorkflowInstanceList: Workflows
 BreadcrumbWorkflowInstanceNew: New workflow
+BreadcrumbWorkflowInstanceUpdate !ident-ok: Update
 BreadcrumbWorkflowWorkflowList: Running workflows
 BreadcrumbWorkflowWorkflow workflow: #{toPathPiece workflow}
 BreadcrumbWorkflowWorkflowFiles: Files
@@ -186,3 +187,4 @@ BreadcrumbSheetCurrent: Current exercise sheet
 BreadcrumbSheetOldUnassigned: Submissions without corrector
 BreadcrumbLogin: Login
 BreadcrumbNews: News
+BreadcrumbSubmissionAuthorshipStatements: Statements of Authorship

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -121,6 +121,7 @@ MenuAdminWorkflowDefinitionDelete: Löschen
 MenuAdminWorkflowInstanceList: Workflow-Instanzen
 MenuAdminWorkflowInstanceNew: Neue Workflow-Instanz
 MenuAdminWorkflowDefinitionInstantiate: Instanziieren
+MenuWorkflowInstanceUpdate !ident-ok: Update
 MenuWorkflowInstanceDelete: Löschen
 MenuWorkflowInstanceWorkflows: Laufende Workflows
 MenuWorkflowInstanceInitiate: Workflow starten

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -122,6 +122,7 @@ MenuAdminWorkflowDefinitionDelete: Delete
 MenuAdminWorkflowInstanceList: Workflow instances
 MenuAdminWorkflowInstanceNew: New workflow instance
 MenuAdminWorkflowDefinitionInstantiate: Instantiate
+MenuWorkflowInstanceUpdate !ident-ok: Update
 MenuWorkflowInstanceDelete: Delete
 MenuWorkflowInstanceWorkflows: Running workflows
 MenuWorkflowInstanceInitiate: Start workflow

models/authorship-statements.model

@@ -0,0 +1,12 @@
+AuthorshipStatementDefinition
+    hash AuthorshipStatementReference
+    content I18nStoredMarkup
+    Primary hash
+    deriving Generic
+
+AuthorshipStatementSubmission
+    statement AuthorshipStatementDefinitionId
+    submission SubmissionId OnDeleteCascade OnUpdateCascade
+    user UserId
+    time UTCTime
+    deriving Generic

models/config.model

@@ -5,3 +5,9 @@ ClusterConfig
     value               Value              -- JSON-encoded value
     Primary setting
     deriving Generic
+
+VolatileClusterConfig
+    setting             VolatileClusterSettingsKey
+    value               Value
+    Primary setting
+    deriving Generic

models/exams.model

@@ -20,6 +20,7 @@ Exam
   examMode ExamMode
   staff Text Maybe
   partsFrom UTCTime Maybe
+  authorshipStatement AuthorshipStatementDefinitionId Maybe
   UniqueExam course name
   deriving Generic
 ExamPart

models/schools.model

@@ -8,6 +8,12 @@ School json
     examRequireModeForRegistration Bool default=false
     examDiscouragedModes ExamModeDNF
     examCloseMode ExamCloseMode default='separate'
+    sheetAuthorshipStatementMode SchoolAuthorshipStatementMode default='optional'
+    sheetAuthorshipStatementDefinition AuthorshipStatementDefinitionId Maybe
+    sheetAuthorshipStatementAllowOther Bool default=true
+    sheetExamAuthorshipStatementMode SchoolAuthorshipStatementMode default='optional'
+    sheetExamAuthorshipStatementDefinition AuthorshipStatementDefinitionId Maybe
+    sheetExamAuthorshipStatementAllowOther Bool default=true
     UniqueSchool name
     UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
     Primary shorthand        -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }

models/sheets.model

@@ -15,6 +15,9 @@ Sheet   -- exercise sheet for a given course
     anonymousCorrection Bool default=true
     requireExamRegistration ExamId Maybe -- Students may only submit if they are registered for the given exam
     allowNonPersonalisedSubmission Bool default=true
+    authorshipStatementMode SheetAuthorshipStatementMode default='exam'
+    authorshipStatementExam ExamId Maybe
+    authorshipStatement AuthorshipStatementDefinitionId Maybe  -- sheet-specific authorship statement; for exam-unrelated sheets and as exam setting overrides
     CourseSheet course name
     deriving Generic
 SheetEdit                     -- who edited when a row in table "Course", kept indefinitely
@@ -59,9 +62,9 @@ PersonalisedSheetFile
     deriving Eq Ord Read Show Typeable Generic
 
 FallbackPersonalisedSheetFilesKey
-    course    CourseId OnDeleteCascade OnUpdateCascade
+    course     CourseId OnDeleteCascade OnUpdateCascade
-    index     Word24
+    index      Word24
-    secret    ByteString
+    secret     ByteString
-    generated UTCTime
+    generated  UTCTime
     UniqueFallbackPersonalisedSheetFilesKey course index
     deriving Generic

package-lock.json

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

package.json

@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "25.14.2",
+  "version": "25.20.2",
   "description": "",
   "keywords": [],
   "author": "",

package.yaml

@@ -1,5 +1,5 @@
 name: uniworx
-version: 25.14.2
+version: 25.20.2
 dependencies:
   - base
   - yesod

routes

@@ -80,6 +80,7 @@
   /delete                     GWIDeleteR       GET POST
   /workflows                  GWIWorkflowsR    GET             !¬empty
   /initiate                   GWIInitiateR     GET POST        !workflow
+  /update                     GWIUpdateR           POST
 /global-workflows             GlobalWorkflowWorkflowListR GET  !free
 !/global-workflows/#CryptoFileNameWorkflowWorkflow GlobalWorkflowWorkflowR:
   /                           GWWWorkflowR     GET POST        !workflow
@@ -146,6 +147,7 @@
     /delete                SWIDeleteR    GET POST
     /workflows             SWIWorkflowsR GET                   !¬empty
     /initiate              SWIInitiateR  GET POST              !workflow
+    /update                SWIUpdateR        POST
   /workflows               SchoolWorkflowWorkflowListR GET     !free
   !/workflows/#CryptoFileNameWorkflowWorkflow SchoolWorkflowWorkflowR:
     /                      SWWWorkflowR  GET POST              !workflow
@@ -216,6 +218,7 @@
       /assign                   SubAssignR     GET POST        !lecturerANDtime
       /correction               CorrectionR    GET POST        !corrector !ownerANDreadANDratedANDexam-time
       /invite                   SInviteR       GET POST        !ownerANDtimeANDuser-submissionsANDsubmission-groupANDexam-registeredANDpersonalised-sheet-files
+      /authorship-statements    SubAuthorshipStatementsR GET   !owner !correctorAND¬correction-anonymous
       !/#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

shell.nix

@@ -157,7 +157,7 @@ let
           [[ -n "$maildev_pid" ]] && kill $maildev_pid
         }
 
-        ${pkgs.nodePackages.maildev}/bin/maildev --smtp $(($PORT_OFFSET + 1025)) --web $(($PORT_OFFSET + 8080)) --ip localhost --web-ip localhost &>/dev/null &
+        TMPDIR=''${XDG_RUNTIME_DIR} ${pkgs.nodePackages.maildev}/bin/maildev --smtp $(($PORT_OFFSET + 1025)) --web $(($PORT_OFFSET + 8080)) --ip localhost --web-ip localhost &>/dev/null &
         maildev_pid=$!
 
         export SMTPHOST=localhost
@@ -252,8 +252,14 @@ let
       sleep 1
     done
   '';
+
+  diffRunning = pkgs.writeScriptBin "diff-running" ''
+    #!${pkgs.zsh}/bin/zsh
+
+    git diff $(cut -d '-' -f 1 <(curl -sH 'Accept: text/plain' https://uni2work.ifi.lmu.de/version))
+  '';
 in pkgs.mkShell {
   name = "uni2work";
   
-  nativeBuildInputs = [develop inDevelop killallUni2work] ++ (with pkgs; [ nodejs-14_x postgresql_12 openldap google-chrome exiftool memcached minio minio-client gup ]) ++ (with pkgs.haskellPackages; [ stack yesod-bin hlint cabal-install weeder profiteur ]);
+  nativeBuildInputs = [develop inDevelop killallUni2work diffRunning] ++ (with pkgs; [ nodejs-14_x postgresql_12 openldap google-chrome exiftool memcached minio minio-client gup ]) ++ (with pkgs.haskellPackages; [ stack yesod-bin hlint cabal-install weeder profiteur ]);
 }

src/Application.hs

@@ -17,9 +17,10 @@ module Application
     ) where
 
 import Control.Monad.Logger                 (liftLoc, LoggingT(..), MonadLoggerIO(..))
-import Database.Persist.Postgresql          ( openSimpleConn, pgConnStr, connClose, pgPoolIdleTimeout
+import Database.Persist.Postgresql          ( openSimpleConn, pgConnStr, pgPoolIdleTimeout
                                             , pgPoolSize
                                             )
+import Database.Persist.SqlBackend.Internal ( connClose )
 import qualified Database.PostgreSQL.Simple as PG
 import Import                        hiding (cancel, respond)
 import Language.Haskell.TH.Syntax           (qLocation)
@@ -115,6 +116,8 @@ import qualified Utils.Pool as Custom
 import Utils.Postgresql
 import Handler.Utils.Memcached (manageMemcachedLocalInvalidations)
 
+import qualified System.Clock as Clock
+
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
 import Handler.News
@@ -142,6 +145,7 @@ import Handler.Participants
 import Handler.StorageKey
 import Handler.Workflow
 import Handler.Error
+import Handler.Upload
 
 
 -- This line actually creates our YesodDispatch instance. It is the second half
@@ -211,7 +215,7 @@ makeFoundation appSettings''@AppSettings{..} = do
     -- from there, and then create the real foundation.
     let
       mkFoundation :: _ -> (forall m. MonadIO m => Custom.Pool' m DBConnLabel DBConnUseState SqlBackend) -> _
-      mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey = UniWorX {..}
+      mkFoundation appSettings' appConnPool appSmtpPool appLdapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache = 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
@@ -231,6 +235,8 @@ makeFoundation appSettings''@AppSettings{..} = do
         (error "MinioConn forced in tempFoundation")
         (error "VerpSecret forced in tempFoundation")
         (error "AuthKey forced in tempFoundation")
+        (error "PersonalisedSheetFilesSeedKey forced in tempFoundation")
+        (error "VolatileClusterSettingsCache forced in tempFoundation")
 
     runAppLoggingT tempFoundation $ do
       $logInfoS "InstanceID" $ UUID.toText appInstanceID
@@ -291,6 +297,11 @@ makeFoundation appSettings''@AppSettings{..} = do
       appClusterID <- clusterSetting (Proxy :: Proxy 'ClusterId) `customRunSqlPool` sqlPool
       appVerpSecret <- clusterSetting (Proxy :: Proxy 'ClusterVerpSecret) `customRunSqlPool` sqlPool
       appAuthKey <- clusterSetting (Proxy :: Proxy 'ClusterAuthKey) `customRunSqlPool` sqlPool
+      appPersonalisedSheetFilesSeedKey <- clusterSetting (Proxy :: Proxy 'ClusterPersonalisedSheetFilesSeedKey) `customRunSqlPool` sqlPool
+
+      let appVolatileClusterSettingsCacheTime' = Clock.fromNanoSecs ns
+            where (MkFixed ns :: Nano) = realToFrac appVolatileClusterSettingsCacheTime
+      appVolatileClusterSettingsCache <- newTVarIO $ mkVolatileClusterSettingsCache appVolatileClusterSettingsCacheTime'
 
       needsRechunk <- exists [FileContentChunkContentBased !=. True] `customRunSqlPool` sqlPool
       let appSettings' = appSettings''
@@ -324,7 +335,7 @@ makeFoundation appSettings''@AppSettings{..} = do
 
       $logDebugS "Runtime configuration" $ tshow appSettings'
 
-      let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey
+      let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache
 
       -- Return the foundation
       $logDebugS "setup" "Done"

src/Audit/Types.hs

@@ -169,9 +169,13 @@ data Transaction
     }
 
   | TransactionUserAssimilated
-    { transactionUser            :: UserId
+    { transactionUser
     , transactionAssimilatedUser :: UserId
     }
+  | TransactionUserIdentChanged
+    { transactionOldUserIdent
+    , transactionNewUserIdent    :: UserIdent
+    }
 
   | TransactionAllocationUserEdited
     { transactionUser       :: UserId

src/Auth/LDAP.hs

@@ -204,7 +204,7 @@ campusLogin pool mode = AuthPlugin{..}
           searchResults <- findUser conf ldap campusIdent [ldapUserPrincipalName]
           case searchResults of
             [Ldap.SearchEntry (Ldap.Dn userDN) userAttrs]
-              | [principalName] <- nub $ fold [ v | (k, v) <- userAttrs, k == ldapUserPrincipalName ]
+              | [principalName] <- nubOrd $ fold [ v | (k, v) <- userAttrs, k == ldapUserPrincipalName ]
               , Right credsIdent <- Text.decodeUtf8' principalName
               -> handleIf isInvalidCredentials (return . Left) $ do
                    Ldap.bind ldap (Ldap.Dn credsIdent) . Ldap.Password $ Text.encodeUtf8 campusPassword

src/Data/Universe/TH.hs

@@ -14,7 +14,8 @@ import Data.Universe.Helpers (interleave)
 
 import Control.Monad (unless)
 
-import Data.List (elemIndex, nub)
+import Data.List (elemIndex)
+import Data.Containers.ListUtils
   
 import Control.Lens hiding (universe)
 import Data.Generics.Product.Types
@@ -81,7 +82,7 @@ deriveUniverse' interleaveExp universeExp mkCxt tName = do
               usesVar ConstructorInfo{..} n
                 | n `elem` map getTVBName constructorVars = False
                 | otherwise = any (elemOf types n) constructorFields
-              fieldTypes = nub $ concatMap constructorFields datatypeCons
+              fieldTypes = nubOrd $ concatMap constructorFields datatypeCons
 
   iCxt' <- cxt iCxt
 

src/Foundation/Authorization.hs

@@ -63,6 +63,8 @@ import qualified Data.Binary as Binary
 import GHC.TypeLits (TypeError)
 import qualified GHC.TypeLits as TypeError (ErrorMessage(..))
 
+import Utils.VolatileClusterSettings
+
 
 type BearerAuthSite site
   = ( MonadCrypto (HandlerFor site)
@@ -464,6 +466,11 @@ maybeCurrentBearerRestrictions = runMaybeT $ do
   route <- MaybeT getCurrentRoute
   hoistMaybe $ bearer ^? _bearerRestrictionIx route
 
+workflowsEnabledAuth :: (MonadHandler m, HandlerSite m ~ UniWorX)
+                     => m AuthResult
+                     -> m AuthResult
+workflowsEnabledAuth = volatileBool clusterVolatileWorkflowsEnabled (unauthorizedI MsgWorkflowsDisabled)
+
 data AuthorizationCacheKey
   = AuthCacheWorkflowWorkflowEdgeActors CryptoFileNameWorkflowWorkflow
   | AuthCacheWorkflowWorkflowViewers CryptoFileNameWorkflowWorkflow
@@ -472,6 +479,7 @@ data AuthorizationCacheKey
   | AuthCacheSchoolFunctionList SchoolFunction | AuthCacheSystemFunctionList SystemFunction
   | AuthCacheLecturerList | AuthCacheExternalExamStaffList | AuthCacheCorrectorList | AuthCacheExamCorrectorList | AuthCacheTutorList | AuthCacheSubmissionGroupUserList
   | AuthCacheCourseRegisteredList TermId SchoolId CourseShorthand
+  | AuthCacheVisibleSystemMessages
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
   deriving anyclass (Hashable, Binary)
 
@@ -562,8 +570,8 @@ tagAccessPredicate AuthStudent = cacheAPSystemFunction SystemStudent (Just $ Rig
       | otherwise -> unauthorizedI MsgUnauthorizedStudent
   | otherwise -> Left $ APDB $ \_ _ mAuthId _ _ -> $cachedHereBinary mAuthId . exceptT return return $ do
       authId <- maybeExceptT AuthenticationRequired $ return mAuthId
-      isExamOffice <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemStudent, UserSystemFunctionIsOptOut ==. False]
+      isStudent <- lift $ exists [UserSystemFunctionUser ==. authId, UserSystemFunctionFunction ==. SystemStudent, UserSystemFunctionIsOptOut ==. False]
-      guardMExceptT isExamOffice $ unauthorizedI MsgUnauthorizedStudent
+      guardMExceptT isStudent $ unauthorizedI MsgUnauthorizedStudent
       return Authorized
 tagAccessPredicate AuthExamOffice = cacheAPSchoolFunction SchoolExamOffice (Just $ Right diffHour) $ \mAuthId' route' _ examOfficeList -> if
   | maybe True (`Set.notMember` examOfficeList) mAuthId' -> Right $ case route' of
@@ -786,11 +794,17 @@ tagAccessPredicate AuthCorrector = cacheAPDB (Just $ Right diffMinute) AuthCache
             E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val authId
           return Authorized
   where
-    mkCorrectorList = execWriterT $ do
+    mkCorrectorList = do
-      tellM . fmap (setOf $ folded . _Value . _Just) . E.select . E.from $ \submission -> do
+      submissionCorrectors <- E.select . E.from $ \submission -> E.distinctOnOrderBy [E.asc $ submission E.^. SubmissionRatingBy] $ do
         E.where_ . E.isJust $ submission E.^. SubmissionRatingBy
         return $ submission E.^. SubmissionRatingBy
-      tellM . fmap (setOf $ folded . _Value) . E.select . E.from $ return . (E.^. SheetCorrectorUser)
+      let submissionCorrectors' = Set.fromDistinctAscList $ mapMaybe (preview $ _Value . _Just) submissionCorrectors
+
+      sheetCorrectors <- E.select . E.from $ \sheetCorrector -> E.distinctOnOrderBy [E.asc $ sheetCorrector E.^. SheetCorrectorUser] $
+        return $ sheetCorrector E.^. SheetCorrectorUser
+      let sheetCorrectors' = Set.fromDistinctAscList $ map (^. _Value) sheetCorrectors
+
+      return $ submissionCorrectors' `Set.union` sheetCorrectors'
 tagAccessPredicate AuthExamCorrector = cacheAPDB (Just $ Right diffMinute) AuthCacheExamCorrectorList mkExamCorrectorList $ \mAuthId' route' _ examCorrectorList -> if
   | maybe True (`Set.notMember` examCorrectorList) mAuthId' -> Right $ case route' of
       _ | is _Nothing mAuthId' -> return AuthenticationRequired
@@ -1046,10 +1060,22 @@ tagAccessPredicate AuthTime = APDB $ \_ (runTACont -> cont) mAuthId route isWrit
 
   MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
     smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
-    SystemMessage{systemMessageFrom, systemMessageTo} <- $cachedHereBinary smId . MaybeT $ get smId
+    cTime <- liftIO getCurrentTime
-    cTime <- NTop . Just <$> liftIO getCurrentTime
+    let cacheTime = diffDay
-    guard $ NTop systemMessageFrom <= cTime
+        massageVisible = Map.fromList . map (over _1 E.unValue . over (_2 . _1) E.unValue . over (_2 . _2) E.unValue)
-         && NTop systemMessageTo   >= cTime
+    visibleSystemMessages <- lift . memcacheAuth' @(Map SystemMessageId (Maybe UTCTime, Maybe UTCTime)) (Right cacheTime) AuthCacheVisibleSystemMessages . fmap massageVisible . E.select . E.from $ \systemMessage -> do
+      E.where_ $ E.maybe E.true (E.>=. E.val cTime) (systemMessage E.^. SystemMessageTo)
+           E.&&. E.maybe E.false (E.<=. E.val (realToFrac diffDay `addUTCTime` cTime)) (systemMessage E.^. SystemMessageFrom) -- good enough.
+      return
+        ( systemMessage E.^. SystemMessageId
+        , ( systemMessage E.^. SystemMessageFrom
+          , systemMessage E.^. SystemMessageTo
+          )
+        )
+    (msgFrom, msgTo) <- hoistMaybe $ Map.lookup smId visibleSystemMessages
+    let cTime' = NTop $ Just cTime
+    guard $ NTop msgFrom <= cTime'
+         && NTop msgTo   >= cTime'
     return Authorized
 
   MessageHideR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
@@ -1543,7 +1569,7 @@ tagAccessPredicate AuthEmpty = APDB $ \evalCtx eval' mAuthId route _ -> do
       orAR' = shortCircuitM (is _Authorized) (orAR mr)
       _andAR' = shortCircuitM (is _Unauthorized) (andAR mr)
 
-      workflowInstanceWorkflowsEmpty rScope win = selectLanguageI18n <=< $cachedHereBinary (evalCtx, mAuthId, route) . maybeT (unauthorizedI18n MsgUnauthorizedWorkflowWorkflowsNotEmpty) $ do
+      workflowInstanceWorkflowsEmpty rScope win = workflowsEnabledAuth $ selectLanguageI18n <=< $cachedHereBinary (evalCtx, mAuthId, route) . maybeT (unauthorizedI18n MsgUnauthorizedWorkflowWorkflowsNotEmpty) $ do
         roles <- memcacheAuth' (Right diffDay) (AuthCacheWorkflowInstanceWorkflowViewers win rScope) $ do
           scope <- fromRouteWorkflowScope rScope
           let dbScope = scope ^. _DBWorkflowScope
@@ -1649,6 +1675,13 @@ tagAccessPredicate AuthCorrectorSubmissions = APDB $ \_ _ _ route _ -> case rout
     guard submissionModeCorrector
     return Authorized
   r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
+tagAccessPredicate AuthCorrectionAnonymous = APDB $ \_ _ _ route _ -> case route of
+  CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedCorrectionAnonymous) $ do
+    Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
+    Entity _ Sheet{ sheetAnonymousCorrection } <- $cachedHereBinary (cid, shn) . MaybeT . getBy $ CourseSheet cid shn
+    guard sheetAnonymousCorrection
+    return Authorized
+  r -> $unsupportedAuthPredicate AuthCorrectionAnonymous r
 tagAccessPredicate AuthSelf = APDB $ \_ _ mAuthId route _ -> exceptT return return $ do
   referencedUser' <- case route of
     AdminUserR cID -> return $ Left cID
@@ -1712,7 +1745,7 @@ tagAccessPredicate AuthAuthentication = APDB $ \_ _ mAuthId route _ -> case rout
     guard $ not systemMessageAuthenticatedOnly || isAuthenticated
     return Authorized
   r -> $unsupportedAuthPredicate AuthAuthentication r
-tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite -> do
+tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite -> workflowsEnabledAuth $ do
   mr <- getMsgRenderer
   let orAR', _andAR' :: forall m'. Monad m' => m' AuthResult -> m' AuthResult -> m' AuthResult
       orAR' = shortCircuitM (is _Authorized) (orAR mr)
@@ -1720,7 +1753,7 @@ tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite ->
 
     
       wInitiate win rScope = selectLanguageI18n <=< $memcacheAuthHere' (Right diffDay) (evalCtx, route, mAuthId) . maybeT (unauthorizedI18n MsgUnauthorizedWorkflowInitiate) $ do -- @isWrite@ not included since it should make no difference regarding initiation (in the end that will always be a write)
-        roles <- memcacheAuth' (Right diffDay) (AuthCacheWorkflowInstanceInitiators win rScope) $ do
+        roles <- memcacheAuth' @(Set (WorkflowRole UserId)) (Right diffDay) (AuthCacheWorkflowInstanceInitiators win rScope) $ do
           scope <- MaybeT . $cachedHereBinary rScope . runMaybeT $ fromRouteWorkflowScope rScope
           Entity _ WorkflowInstance{..} <- $cachedHereBinary (win, scope) . MaybeT . getBy . UniqueWorkflowInstance win $ scope ^. _DBWorkflowScope
           wiGraph <- lift $ getSharedIdWorkflowGraph workflowInstanceGraph
@@ -1753,7 +1786,7 @@ tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite ->
             guardM . fmap (is _Authorized) $ ofoldl1' orAR' . mapNonNull evalRole =<< hoistMaybe (fromNullable $ otoList edges)
             return Authorized
         | otherwise = flip orAR' (wWorkflow True cID) . maybeT (unauthorizedI MsgUnauthorizedWorkflowRead) $ do
-            (wwId, roles) <- memcacheAuth' (Right diffDay) (AuthCacheWorkflowWorkflowViewers cID) $ do
+            (wwId, roles) <- memcacheAuth' @(WorkflowWorkflowId, Set (WorkflowRole UserId)) (Right diffDay) (AuthCacheWorkflowWorkflowViewers cID) $ do
               wwId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
               WorkflowWorkflow{..} <- MaybeT . $cachedHereBinary wwId $ get wwId
               wwGraph <- lift $ getSharedIdWorkflowGraph workflowWorkflowGraph
@@ -1772,7 +1805,7 @@ tagAccessPredicate AuthWorkflow = APDB $ \evalCtx eval' mAuthId route isWrite ->
                   guard $ Map.lookup payload (workflowStateCurrentPayloads prevActs) /= Map.lookup payload (wpPayload act)
                   fmap (toNullable . wpvViewers) . hoistMaybe $ Map.lookup payload . wgnPayloadView =<< Map.lookup (wpTo prevAct) (wgNodes wwGraph)
 
-              return (wwId, fold nodeViewers <> fold payloadViewers :: (Set (WorkflowRole UserId)))
+              return (wwId, fold nodeViewers <> fold payloadViewers)
               
             let
               evalRole role = lift . evalWriterT $ evalWorkflowRoleFor' eval' mAuthId (Just wwId) role route isWrite
@@ -1837,6 +1870,28 @@ routeAuthTags = fmap predDNFEntail . ofoldM parse defaultAuthDNF . routeAttrs
       Just t' -> Right . predDNFOr prev . PredDNF $ Set.singleton t'
       Nothing -> Left $ InvalidAuthTag t
 
+broadenRoute :: AuthTag -> Route UniWorX -> Route UniWorX
+broadenRoute aTag route = case (aTag, route) of
+  (AuthAdmin, CourseR tid ssh csh _) -> CourseR tid ssh csh CShowR
+  (AuthAdmin, AllocationR tid ssh ash _) -> AllocationR tid ssh ash AShowR
+  (AuthAdmin, SchoolR ssh _) -> SchoolR ssh SchoolEditR
+  (AuthAdmin, _) -> NewsR
+
+  (AuthStudent, _) -> NewsR
+
+  (AuthExamOffice, CExamR tid ssh csh examn _) -> CExamR tid ssh csh examn EShowR
+  (AuthExamOffice, EExamR tid ssh coursen examn _) -> EExamR tid ssh coursen examn EEShowR
+  (AuthExamOffice, CourseR _ ssh _ _) -> SchoolR ssh SchoolEditR
+  (AuthExamOffice, SchoolR ssh _) -> SchoolR ssh SchoolEditR
+  (AuthExamOffice, _) -> NewsR
+
+  (AuthLecturer, CourseR tid ssh csh _) -> CourseR tid ssh csh CShowR
+  (AuthLecturer, AllocationR tid ssh ash _) -> AllocationR tid ssh ash AShowR
+  (AuthLecturer, EExamR tid ssh coursen examn _) -> EExamR tid ssh coursen examn EEShowR
+  (AuthLecturer, _) -> NewsR
+
+  _other -> route
+
 evalAuthTags :: forall ctx m. (HasCallStack, Binary ctx, MonadAP m) => ctx -> AuthTagActive -> (forall m'. MonadAP m' => AuthTagsEval m') -> AuthTagsEval m
 -- ^ `tell`s disabled predicates, identified as pivots
 evalAuthTags ctx authActive@AuthTagActive{..} cont (map (Set.toList . toNullable) . Set.toList . dnfTerms -> authDNF') mAuthId route isWrite
@@ -1850,8 +1905,9 @@ evalAuthTags ctx authActive@AuthTagActive{..} cont (map (Set.toList . toNullable
         authTagIsInactive = not . authTagIsActive
 
         evalAuthTag :: AuthTag -> WriterT (Set AuthTag) m AuthResult
-        evalAuthTag authTag = lift . ($runCachedMemoT :: CachedMemoT (ctx, AuthTag, Maybe UserId, Route UniWorX, Bool) AuthResult m _ -> m _) $ for5 memo (const evalAccessPred') ctx authTag mAuthId route isWrite
+        evalAuthTag authTag = lift . ($runCachedMemoT :: CachedMemoT (ctx, AuthTag, Maybe UserId, Route UniWorX, Bool) AuthResult m _ -> m _) $ for5 memo (const evalAccessPred') ctx authTag mAuthId route'' isWrite
           where
+            route'' = broadenRoute authTag route
             evalAccessPred' authTag' mAuthId' route' isWrite' = lift $ do
               $logDebugS "evalAccessPred" $ tshow (authTag', mAuthId', route', isWrite')
               observeAuthTagEvaluation authTag' (classifyHandler route') $ do
@@ -1979,7 +2035,7 @@ evalWorkflowRoleFor' :: forall m backend.
                      -> Route UniWorX
                      -> Bool
                      -> WriterT (Set AuthTag) (ReaderT backend m) AuthResult
-evalWorkflowRoleFor' eval mAuthId mwwId wRole route isWrite = do
+evalWorkflowRoleFor' eval mAuthId mwwId wRole route isWrite = workflowsEnabledAuth $ do
   mr <- getMsgRenderer
 
   let
@@ -2028,7 +2084,7 @@ evalWorkflowRoleFor :: ( HasCallStack
                     -> Route UniWorX
                     -> Bool
                     -> ReaderT backend m AuthResult
-evalWorkflowRoleFor mAuthId mwwId wRole route isWrite = do
+evalWorkflowRoleFor mAuthId mwwId wRole route isWrite = workflowsEnabledAuth $ do
   isSelf <- (== mAuthId) <$> liftHandler defaultMaybeAuthId
   tagActive <- if
     | isSelf    -> fromMaybe def <$> lookupSessionJson SessionActiveAuthTags
@@ -2052,7 +2108,7 @@ hasWorkflowRole :: ( HasCallStack
                 -> Route UniWorX
                 -> Bool
                 -> ReaderT backend m AuthResult
-hasWorkflowRole mwwId wRole route isWrite = do
+hasWorkflowRole mwwId wRole route isWrite = workflowsEnabledAuth $ do
   mAuthId <- maybeAuthId
   evalWorkflowRoleFor mAuthId mwwId wRole route isWrite
 
@@ -2070,7 +2126,7 @@ mayViewWorkflowAction' :: forall backend m fileid.
                        -> WorkflowWorkflowId
                        -> WorkflowAction fileid UserId
                        -> WriterT (Set AuthTag) (ReaderT backend m) Bool
-mayViewWorkflowAction' eval mAuthId wwId WorkflowAction{..} = hoist (withReaderT $ projectBackend @SqlReadBackend) . maybeT (return False) $ do
+mayViewWorkflowAction' eval mAuthId wwId WorkflowAction{..} = volatileBool clusterVolatileWorkflowsEnabled (return False) . hoist (withReaderT $ projectBackend @SqlReadBackend) . maybeT (return False) $ do
   Entity _ WorkflowWorkflow{..} <- MaybeT . lift $ getWorkflowWorkflowState wwId
   rScope <- hoist lift . toRouteWorkflowScope $ _DBWorkflowScope # workflowWorkflowScope
   cID <- catchMaybeT (Proxy @CryptoIDError) . lift . lift $ encrypt wwId
@@ -2100,7 +2156,7 @@ mayViewWorkflowAction :: forall backend m fileid.
                       -> WorkflowWorkflowId
                       -> WorkflowAction fileid UserId
                       -> ReaderT backend m Bool
-mayViewWorkflowAction mAuthId wwId act = do
+mayViewWorkflowAction mAuthId wwId act = volatileBool clusterVolatileWorkflowsEnabled (return False) $ do
   isSelf <- (== mAuthId) <$> liftHandler defaultMaybeAuthId
   tagActive <- if
     | isSelf    -> fromMaybe def <$> lookupSessionJson SessionActiveAuthTags

src/Foundation/DB.hs

@@ -2,6 +2,7 @@ module Foundation.DB
   ( runDBRead, runDBRead'
   , runSqlPoolRetry, runSqlPoolRetry'
   , dbPoolPressured
+  , runDBInternal, runDBInternal'
   ) where
 
 import Import.NoFoundation hiding (runDB, getDBRunner)
@@ -63,6 +64,15 @@ runDBRead' lbl action = do
   $logDebugS "YesodPersist" "runDBRead"
   flip (runSqlPoolRetry' . withReaderT SqlReadBackend $ [executeQQ|SET TRANSACTION READ ONLY|] *> action) lbl . appConnPool =<< getYesod
   
+runDBInternal :: HasCallStack
+              => ReaderT SqlBackend (HandlerFor UniWorX) a -> HandlerFor UniWorX a
+runDBInternal = runDBInternal' callStack
+
+runDBInternal' :: CallStack -> ReaderT SqlBackend (HandlerFor UniWorX) a -> HandlerFor UniWorX a
+runDBInternal' lbl action = do
+  $logDebugS "YesodPersist" "runDBInternal"
+  flip (runSqlPoolRetry' action) lbl . appConnPool =<< getYesod
+
 dbPoolPressured :: ( MonadHandler m
                    , HandlerSite m ~ UniWorX
                    )

src/Foundation/I18n.hs

@@ -14,6 +14,7 @@ module Foundation.I18n
   , UniWorXMetricsMessage(..), UniWorXNewsMessage(..), UniWorXSchoolMessage(..), UniWorXSystemMessageMessage(..)
   , UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..)
   , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..)
+  , UniWorXAuthorshipStatementMessage(..)
   , ShortTermIdentifier(..)
   , MsgLanguage(..)
   , ShortSex(..)
@@ -190,6 +191,7 @@ mkMessageAddition ''UniWorX "TablePagination" "messages/uniworx/utils/table_pagi
 mkMessageAddition ''UniWorX "Util" "messages/uniworx/utils/utils" "de-de-formal"
 mkMessageAddition ''UniWorX "Rating" "messages/uniworx/utils/rating" "de-de-formal"
 mkMessageAddition ''UniWorX "SiteLayout" "messages/uniworx/utils/site_layout" "de-de-formal"
+mkMessageAddition ''UniWorX "AuthorshipStatement" "messages/uniworx/utils/authorship_statement" "de-de-formal"
 mkMessageVariant ''UniWorX ''CampusMessage "messages/auth/campus" "de"
 mkMessageVariant ''UniWorX ''DummyMessage "messages/auth/dummy" "de"
 mkMessageVariant ''UniWorX ''PWHashMessage "messages/auth/pw-hash" "de"
@@ -232,17 +234,19 @@ instance RenderMessage UniWorX Load where
     Load { byTutorial = Just True , byProportion = p } -> MsgCorByProportionIncludingTutorial p
     Load { byTutorial = Just False, byProportion = p } -> MsgCorByProportionExcludingTutorial p
 
-newtype MsgLanguage = MsgLanguage Lang
+data MsgLanguage = MsgLanguage { unMsgLanguage :: Lang } | MsgLanguageEndonym { unMsgLanguage :: Lang }
   deriving stock (Eq, Ord, Show, Read)
 instance RenderMessage UniWorX MsgLanguage where
-  renderMessage foundation ls (MsgLanguage lang@(map mk . Text.splitOn "-" -> lang'))
+  renderMessage foundation ls msg@(unMsgLanguage -> lang@(map mk . Text.splitOn "-" -> lang'))
     | ("de" : "DE" : _) <- lang' = mr MsgGermanGermany
     | ("de" : _)        <- lang' = mr MsgGerman
     | ("en" : "EU" : _) <- lang' = mr MsgEnglishEurope
     | ("en" : _)        <- lang' = mr MsgEnglish
     | otherwise = lang
     where
-      mr = renderMessage foundation $ lang : filter (/= lang) ls
+      mr = renderMessage foundation $ case msg of
+        MsgLanguageEndonym _ -> lang : filter (/= lang) ls
+        MsgLanguage _ -> ls
 
 appLanguagesOpts :: ( MonadHandler m
                     , RenderMessage (HandlerSite m) MsgLanguage
@@ -301,6 +305,9 @@ embedRenderMessage ''UniWorX ''UrlFieldMessage id
 
 embedRenderMessageVariant ''UniWorX ''ADInvalidCredentials ("InvalidCredentials" <>)
 
+embedRenderMessage ''UniWorX ''SchoolAuthorshipStatementMode id
+embedRenderMessage ''UniWorX ''SheetAuthorshipStatementMode id
+
 newtype ShortSex = ShortSex Sex
 embedRenderMessageVariant ''UniWorX ''ShortSex ("Short" <>)
 
@@ -501,18 +508,18 @@ instance RenderMessage UniWorX RouteWorkflowScope where
       mr = renderMessage foundation ls
 
 
-unRenderMessage' :: (Eq a, Finite a, RenderMessage master a) => (Text -> Text -> Bool) -> master -> Text -> [a]
+unRenderMessage' :: (Ord a, Finite a, RenderMessage master a) => (Text -> Text -> Bool) -> master -> Text -> [a]
-unRenderMessage' cmp foundation inp = nub $ do
+unRenderMessage' cmp foundation inp = nubOrd $ do
   l <- appLanguages'
   x <- universeF
   guard $ renderMessage foundation (l : filter (/= l) appLanguages') x `cmp` inp
   return x
   where appLanguages' = toList appLanguages
 
-unRenderMessage :: (Eq a, Finite a, RenderMessage master a) => master -> Text -> [a]
+unRenderMessage :: (Ord a, Finite a, RenderMessage master a) => master -> Text -> [a]
 unRenderMessage = unRenderMessage' (==)
 
-unRenderMessageLenient :: forall a master. (Eq a, Finite a, RenderMessage master a) => master -> Text -> [a]
+unRenderMessageLenient :: forall a master. (Ord a, Finite a, RenderMessage master a) => master -> Text -> [a]
 unRenderMessageLenient = unRenderMessage' cmp
   where cmp = (==) `on` mk . under packed (filter Char.isAlphaNum . concatMap unidecode)
 

src/Foundation/Navigation.hs

@@ -47,6 +47,8 @@ import qualified Data.Set as Set
 
 import Data.List (inits)
 
+import Utils.VolatileClusterSettings
+
 
 type Breadcrumb = (Text, Maybe (Route UniWorX))
   
@@ -141,6 +143,7 @@ breadcrumb (SchoolR ssh sRoute) = case sRoute of
       i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just . SchoolR ssh $ if
         | mayEdit -> SchoolWorkflowInstanceR win SWIEditR
         | otherwise -> SchoolWorkflowInstanceListR
+    SWIUpdateR -> i18nCrumb MsgBreadcrumbWorkflowInstanceUpdate . Just . SchoolR ssh $ SchoolWorkflowInstanceR win SWIEditR
   SchoolWorkflowWorkflowListR -> i18nCrumb MsgBreadcrumbWorkflowWorkflowList . Just $ SchoolR ssh SchoolWorkflowInstanceListR
   SchoolWorkflowWorkflowR cID sRoute' -> case sRoute' of
     SWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) . Just $ SchoolR ssh SchoolWorkflowWorkflowListR
@@ -322,17 +325,16 @@ breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
   SubmissionR cid sRoute' -> case sRoute' of
     SubShowR -> useRunDB $ do
       mayList <- hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
-      if
+      return ( toPathPiece cid
-        | mayList
+             , Just . CSheetR tid ssh csh shn $ bool SShowR SSubsR mayList
-          -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SSubsR
+             )
-        | otherwise
-          -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SShowR
     CorrectionR -> i18nCrumb MsgMenuCorrection . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubDelR -> i18nCrumb MsgMenuSubmissionDelete . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubAssignR -> i18nCrumb MsgCorrectorAssignTitle . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SInviteR -> i18nCrumb MsgBreadcrumbSubmissionUserInvite . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubArchiveR sft -> i18nCrumb sft . Just $ CSubmissionR tid ssh csh shn cid SubShowR
     SubDownloadR _ _ -> i18nCrumb MsgBreadcrumbSubmissionFile . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+    SubAuthorshipStatementsR -> i18nCrumb MsgBreadcrumbSubmissionAuthorshipStatements . Just $ CSubmissionR tid ssh csh shn cid SubShowR
   SArchiveR -> i18nCrumb MsgBreadcrumbSheetArchive . Just $ CSheetR tid ssh csh shn SShowR
   SIsCorrR -> i18nCrumb MsgBreadcrumbSheetIsCorrector . Just $ CSheetR tid ssh csh shn SShowR
   SPseudonymR -> i18nCrumb MsgBreadcrumbSheetPseudonym . Just $ CSheetR tid ssh csh shn SShowR
@@ -428,6 +430,7 @@ breadcrumb (GlobalWorkflowInstanceR win sRoute) = case sRoute of
     i18nCrumb MsgBreadcrumbWorkflowInstanceInitiate . Just $ if
       | mayEdit -> GlobalWorkflowInstanceR win GWIEditR
       | otherwise -> GlobalWorkflowInstanceListR
+  GWIUpdateR -> i18nCrumb MsgBreadcrumbWorkflowInstanceUpdate . Just $ GlobalWorkflowInstanceR win GWIEditR
 breadcrumb GlobalWorkflowWorkflowListR = i18nCrumb MsgBreadcrumbWorkflowWorkflowList $ Just GlobalWorkflowInstanceListR
 breadcrumb (GlobalWorkflowWorkflowR cID sRoute) = case sRoute of
   GWWWorkflowR -> i18nCrumb (MsgBreadcrumbWorkflowWorkflow cID) $ Just GlobalWorkflowWorkflowListR
@@ -617,7 +620,7 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
       activeLang <- selectLanguage appLanguages
 
       let navChildren = flip map (toList appLanguages) $ \lang -> NavLink
-            { navLabel       = MsgLanguage lang
+            { navLabel       = MsgLanguageEndonym lang
             , navRoute       = (LangR, [(toPathPiece GetReferer, toPathPiece currentRoute) | currentRoute <- hoistMaybe mCurrentRoute ])
             , navAccess'     = NavAccessTrue
             , navType        = NavTypeButton
@@ -756,6 +759,8 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
         }
       }
   , do
+      guardVolatile clusterVolatileWorkflowsEnabled
+      
       authCtx <- getAuthContext
       (haveInstances, haveWorkflows) <- lift . memcachedBy (Just . Right $ 2 * diffMinute) (NavCacheHaveTopWorkflowsInstances authCtx) . useRunDB $ (,)
         <$> haveTopWorkflowInstances
@@ -2732,7 +2737,7 @@ haveTopWorkflowInstances, haveTopWorkflowWorkflows
      )
   => ReaderT backend m Bool
 haveTopWorkflowInstances = hoist liftHandler . withReaderT (projectBackend @SqlReadBackend) . $cachedHere . maybeT (return False) $ do
-  roles <- memcachedBy (Just $ Right diffDay) NavCacheHaveTopWorkflowInstancesRoles $ do
+  roles <- memcachedBy @(Set ((RouteWorkflowScope, WorkflowInstanceName), WorkflowRole UserId)) (Just $ Right diffDay) NavCacheHaveTopWorkflowInstancesRoles $ do
     let
       getInstances = E.selectSource . E.from $ \workflowInstance -> do
         E.where_ . isTopWorkflowScopeSql $ workflowInstance E.^. WorkflowInstanceScope

src/Foundation/SiteLayout.hs

@@ -39,6 +39,9 @@ import Text.Cassius (cassiusFile)
 import Text.Hamlet (hamletFile)
 import Data.FileEmbed (embedFile)
 
+import Utils.VolatileClusterSettings
+
+
 data CourseFavouriteToggleButton
   = BtnCourseFavouriteToggleManual
   | BtnCourseFavouriteToggleAutomatic
@@ -303,7 +306,7 @@ siteLayout' overrideHeading widget = do
               let cK = MemcachedKeyFavouriteQuickActions (tid, ssh, csh) ctx langs
               $logDebugS "FavouriteQuickActions" $ tshow cK <> " Checking..."
               poolIsPressured <- dbPoolPressured
-              items <- if
+              items <- volatileBool clusterVolatileQuickActionsEnabled (return Nothing) $ if
                 | poolIsPressured -> Nothing <$ observeFavouritesSkippedDueToDBLoad
                 | otherwise -> memcachedLimitedKeyTimeoutBy
                     MemcachedLimitKeyFavourites appFavouritesQuickActionsBurstsize appFavouritesQuickActionsAvgInverseRate 1

src/Foundation/Type.hs

@@ -10,7 +10,7 @@ module Foundation.Type
   , AppMemcachedLocal(..)
   , _memcachedLocalARC
   , SMTPPool
-  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey
+  , _appSettings', _appStatic, _appConnPool, _appSmtpPool, _appLdapPool, _appWidgetMemcached, _appHttpManager, _appLogger, _appLogSettings, _appCryptoIDKey, _appClusterID, _appInstanceID, _appJobState, _appSessionStore, _appSecretBoxKey, _appJSONWebKeySet, _appHealthReport, _appMemcached, _appUploadCache, _appVerpSecret, _appAuthKey, _appPersonalisedSheetFilesSeedKey, _appVolatileClusterSettingsCache
   , DB, Form, MsgRenderer, MailM, DBFile
   ) where
 
@@ -37,6 +37,7 @@ import Utils.Metrics (DBConnUseState)
 import qualified Data.ByteString.Lazy as Lazy
 import Data.Time.Clock.POSIX (POSIXTime)
 import GHC.Fingerprint (Fingerprint)
+import Handler.Sheet.PersonalisedFiles.Types (PersonalisedSheetFilesSeedKey)
 
 
 type SMTPPool = Pool SMTPConnection
@@ -93,6 +94,8 @@ data UniWorX = UniWorX
     , appFileSourceARC     :: Maybe (ARCHandle (FileContentChunkReference, (Int, Int)) Int ByteString)
     , appFileSourcePrewarm :: Maybe (LRUHandle (FileContentChunkReference, (Int, Int)) UTCTime Int ByteString)
     , appFileInjectInhibit :: TVar (IntervalMap UTCTime (Set FileContentReference))
+    , appPersonalisedSheetFilesSeedKey :: PersonalisedSheetFilesSeedKey
+    , appVolatileClusterSettingsCache :: TVar VolatileClusterSettingsCache
     } deriving (Typeable)
 
 makeLenses_ ''UniWorX

src/Foundation/Yesod/Auth.hs

@@ -296,7 +296,7 @@ upsertCampusUser upsertMode ldapData = do
       Right str <- return $ Text.decodeUtf8' v'
       return str
 
-    termNames = nubBy ((==) `on` CI.mk) $ do
+    termNames = nubOrdOn CI.mk $ do
       (k, v) <- ldapData
       guard $ k == ldapUserFieldName
       v' <- v
@@ -505,7 +505,7 @@ updateUserLanguage (Just lang) = do
   muid <- maybeAuthId
   for_ muid $ \uid -> do
     langs <- languages
-    update uid [ UserLanguages =. Just (Languages $ lang : nub (filter ((&&) <$> (`elem` appLanguages) <*> (/= lang)) langs)) ]
+    update uid [ UserLanguages =. Just (Languages $ lang : nubOrd (filter ((&&) <$> (`elem` appLanguages) <*> (/= lang)) langs)) ]
   setRegisteredCookie CookieLang lang
   return $ Just lang
 updateUserLanguage Nothing = runMaybeT $ do

src/Handler/Admin/Test.hs

@@ -149,15 +149,16 @@ postAdminTestR = do
     -- This /needs/ to replace all occurrences of @mreq@ with @mpreq@ (no fields should be /actually/ required)
     mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
               -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
+              -> ListLength -- ^ Previous shape of massinput
               -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
               -> FieldView UniWorX -- ^ Submit-Button for this add-widget
               -> Maybe (Form (Map ListPosition Int -> FormResult (Map ListPosition Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cells and data needed to initialize cells
-    mkAddForm 0 0 nudge submitBtn = Just $ \csrf -> do
+    mkAddForm 0 0 liveliness nudge submitBtn = guardOn (allowAdd 0 0 liveliness) $ \csrf -> do
       (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration
       let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done
           addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 (succ . fst) $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data
       return (addRes'', toWidget csrf >> fvWidget addView >> fvWidget submitBtn)
-    mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
+    mkAddForm _pos _dim _ _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
 
     -- | Make a single massInput-Cell
     --
@@ -184,8 +185,9 @@ postAdminTestR = do
 
   -- The actual call to @massInput@ is comparatively simple:
 
-  ((miResult, fvWidget -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing
+  ((miResult, fvWidget -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing
 
+  ((i18nResult, fvWidget -> i18nWidget), i18nEnc) <- runFormPost . identifyForm ("i18n-stored-markup" :: Text) $ i18nField htmlField True (\_ -> Nothing) ("i18n-stored-markup" :: Text) "" True Nothing
 
   testDownloadWidget <- testDownload
 
@@ -229,6 +231,29 @@ postAdminTestR = do
             #{tshow res}
     |]
       
+    i18nIdent <- newIdent
+    let i18nForm' = wrapForm i18nWidget FormSettings
+          { formMethod   = POST
+          , formAction   = Just . SomeRoute $ AdminTestR :#: i18nIdent
+          , formEncoding = i18nEnc
+          , formAttrs    = []
+          , formSubmit   = FormSubmit
+          , formAnchor   = Just i18nIdent
+          }
+    [whamlet|
+      <h2>I18n-Form
+      ^{i18nForm'}
+      $case i18nResult
+        $of FormMissing
+        $of FormFailure errs
+          <ul>
+            $forall err <- errs
+              <li>#{err}
+        $of FormSuccess res
+          <pre .json>
+            #{toYAML res}
+    |]
+
     [whamlet|
        <section>
          <h2>_{MsgTestDownload}

src/Handler/Allocation/Accept.hs

@@ -109,12 +109,12 @@ allocationAcceptForm aId = runMaybeT $ do
 
     let
       showTerms
-        | [_] <- nubOn (view $ _1 . _2 . _entityVal . _courseTerm) allocationCourses'
+        | [_] <- nubOrdOn (view $ _1 . _2 . _entityVal . _courseTerm) allocationCourses'
         = False
         | otherwise
         = True
       showSchools
-        | [_] <- nubOn (view $ _1 . _2 . _entityVal . _courseSchool) allocationCourses'
+        | [_] <- nubOrdOn (view $ _1 . _2 . _entityVal . _courseSchool) allocationCourses'
         = False
         | otherwise
         = True

src/Handler/Allocation/Show.hs

@@ -118,7 +118,7 @@ postAShowR tid ssh ash = do
 
     wouldNotifyNewCourse <- fmap (maybe False E.unValue . join) . for muid $ E.selectMaybe . pure . allocationNotifyNewCourses (E.val aId) . E.val
 
-    return (alloc, school, isAnyLecturer, isAdmin, nubOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
+    return (alloc, school, isAnyLecturer, isAdmin, nubOrdOn (view $ resultCourse . _entityKey) courses, registration, wouldNotifyNewCourse)
 
   let nextSubstitutesDeadline = minimumOf (folded . resultAllocationCourse . _allocationCourseAcceptSubstitutes . _Just . filtered (>= now)) courses
       freeCapacity = fmap getSum . getAp . flip foldMap courses $ \cEntry -> Ap . fmap (Sum . max 0) $ subtract (cEntry ^. resultParticipantCount) <$> preview (resultCourse . _entityVal . _courseCapacity . _Just) cEntry

src/Handler/Course/Application/List.hs

@@ -612,7 +612,7 @@ postCApplicationsR tid ssh csh = do
         sortedApplications <- unstableSortBy cmp applications
 
         let applicants = sortedApplications
-                       & nubOn (view $ _1 . _entityKey)
+                       & nubOrdOn (view $ _1 . _entityKey)
                        & maybe id take openCapacity
                        & setOf (case invMode of
                                   AcceptApplicationsDirect -> folded . _1 . _entityKey . to Right

src/Handler/Course/Edit.hs

@@ -121,7 +121,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
       adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
       oldSchool <- forM (cfCourseId =<< template) $ fmap courseSchool . getJust
       return (lecturerSchools, adminSchools, oldSchool)
-    let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
+    let userSchools = nubOrd . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
 
     (termsField, userTerms) <- liftHandler $ case template of
       -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
@@ -136,8 +136,8 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
               -> return (termsSetField [cfTerm cform], [cfTerm cform])
       _allOtherCases -> (termsAllowedField, ) . Set.toList <$> runDB getActiveTerms
 
-    let miAdd :: ListPosition -> Natural -> (Text -> Text) -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
+    let miAdd :: ListPosition -> Natural -> ListLength -> (Text -> Text) -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
-        miAdd _ _ nudge btn = Just $ \csrf -> do
+        miAdd _ _ _ nudge btn = Just $ \csrf -> do
           (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) (fslI MsgCourseLecturerEmail & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
           let addRes'' = addRes <&> \newDat oldDat -> if
                 | existing <- newDat `Set.intersection` Set.fromList (Map.elems oldDat)
@@ -165,9 +165,6 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
                  -> MaybeT (MForm (HandlerFor UniWorX)) (Map ListPosition ListPosition)
         miDelete = miDeleteList
 
-        miAllowAdd :: ListPosition -> Natural -> ListLength -> Bool
-        miAllowAdd _ _ _ = True
-
         miAddEmpty :: ListPosition -> Natural -> ListLength -> Set ListPosition
         miAddEmpty _ _ _ = Set.empty
 

src/Handler/Course/Users.hs

@@ -623,7 +623,7 @@ postCUsersR tid ssh csh = do
                 , E.desc $ sheet E.^. SheetActiveFrom
                 ]
       return $ sheet E.^. SheetName
-    let exams = nubOn entityKey $ examOccurrencesPerExam ^.. folded . _1
+    let exams = nubOrdOn entityKey $ examOccurrencesPerExam ^.. folded . _1
     let colChoices  = mconcat $ catMaybes
           [ pure . cap' $ dbSelect (applying _2) id (return . view (hasEntity . _entityKey))
           , pure . cap' $ colUserNameLink (CourseR tid ssh csh . CUserR)

src/Handler/Exam/Edit.hs

@@ -40,6 +40,7 @@ postEEditR tid ssh csh examn = do
 
     editExamAct <- formResultMaybe editExamResult $ \ExamForm{..} -> do
       res <- trySql @ExamEditException $ do
+        examAuthorshipStatement <- traverse insertAuthorshipStatement efAuthorshipStatement
         insertRes <- myReplaceUnique eId Exam
           { examCourse           = cid
           , examName             = efName
@@ -62,6 +63,7 @@ postEEditR tid ssh csh examn = do
           , examExamMode         = efExamMode
           , examStaff            = efStaff
           , examPartsFrom        = efPartsFrom
+          , examAuthorshipStatement
           }
 
         when (is _Just insertRes) $

src/Handler/Exam/Form.hs

@@ -52,6 +52,7 @@ data ExamForm = ExamForm
   , efStaff :: Maybe Text
   , efCorrectors :: Set (Either UserEmail UserId)
   , efExamParts :: Set ExamPartForm
+  , efAuthorshipStatement :: Maybe I18nStoredMarkup
   }
 
 data ExamOccurrenceForm = ExamOccurrenceForm
@@ -110,8 +111,11 @@ examForm :: ( MonadHandler m
             )
          => Entity Course -> Maybe ExamForm -> (Html -> MForm m (FormResult ExamForm, Widget))
 examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do
-  MsgRenderer mr <- getMsgRenderer
+  mr'@(MsgRenderer mr) <- getMsgRenderer
-  School{..} <- liftHandler . runDBRead $ getJust courseSchool
+  (School{..}, mSchoolAuthorshipStatement) <- liftHandler . runDBRead $ do
+    school@School{..} <- getJust courseSchool
+    mSchoolAuthorshipStatement <- maybe (pure Nothing) getEntity schoolSheetExamAuthorshipStatementDefinition
+    return (school, mSchoolAuthorshipStatement)
 
   flip (renderAForm FormStandard) csrf $ ExamForm
     <$> areq ciField (fslpI MsgTableExamName (mr MsgTableExamName) & setTooltip MsgExamNameTip) (efName <$> template)
@@ -143,6 +147,31 @@ examForm (Entity _ Course{..}) template csrf = hoist liftHandler $ do
     <*> examCorrectorsForm (efCorrectors <$> template)
     <*  aformSection MsgExamFormParts
     <*> examPartsForm (efExamParts <$> template)
+    <*> let
+          reqContentField :: (FieldSettings UniWorX -> FieldSettings UniWorX) -> AForm Handler I18nStoredMarkup
+          reqContentField ttip = fmapAForm (formResultUnOpt mr' MsgSheetAuthorshipStatementContent)
+                               $ i18nFieldA htmlField True (\_ -> Nothing) ("authorship-statement" :: Text)
+                                 (fslI MsgSheetAuthorshipStatementContent & ttip)
+                                 True
+                                 ( fmap Just $     (efAuthorshipStatement =<< template)
+                                               <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
+                                 )
+          forcedContentField   = aforced forcedAuthorshipStatementField
+                                 (fslI MsgExamAuthorshipStatementContent & setTooltip MsgExamAuthorshipStatementContentForcedTip)
+          contentField ttipReq
+            | not schoolSheetExamAuthorshipStatementAllowOther
+            = fmap (fmap authorshipStatementDefinitionContent) . traverse forcedContentField $ entityVal <$> mSchoolAuthorshipStatement
+            | otherwise
+            = Just <$> reqContentField ttipReq
+        in case schoolSheetExamAuthorshipStatementMode of
+          SchoolAuthorshipStatementModeNone -> pure Nothing  -- suppress display of whole section incl. header
+          otherMode -> aformSection MsgExamAuthorshipStatementSection
+                    *> case otherMode of
+                         SchoolAuthorshipStatementModeOptional -> optionalActionA (fmapAForm (formResultUnOpt mr' MsgSheetAuthorshipStatementContent) $ contentField id)
+                                                                  (fslI MsgExamAuthorshipStatementRequired & setTooltip MsgExamAuthorshipStatementRequiredTip)
+                                                                  ((is _Just . efAuthorshipStatement <$> template) <|> Just (is _Just mSchoolAuthorshipStatement))
+                         SchoolAuthorshipStatementModeRequired -> contentField $ setTooltip MsgExamAuthorshipStatementRequiredForcedTip
+                         _none                                 -> pure Nothing
 
 officeSchoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId)
 officeSchoolsForm mPrev = wFormToAForm $ do
@@ -316,6 +345,8 @@ examFormTemplate (Entity eId Exam{..}) = do
   examParts' <- forM examParts $ \(Entity pid part) -> (,) <$> encrypt pid <*> pure part
   occurrences' <- forM occurrences $ \(Entity oid occ) -> (,) <$> encrypt oid <*> pure occ
 
+  mAuthorshipStatement <- maybe (pure Nothing) getEntity examAuthorshipStatement
+
   return ExamForm
     { efName             = examName
     , efGradingRule      = examGradingRule
@@ -363,6 +394,7 @@ examFormTemplate (Entity eId Exam{..}) = do
     , efExamMode         = examExamMode
     , efOfficeSchools    = Set.fromList $ examOfficeSchoolSchool . entityVal <$> extraSchools
     , efStaff            = examStaff
+    , efAuthorshipStatement = authorshipStatementDefinitionContent . entityVal <$> mAuthorshipStatement
     }
 
 examTemplate :: MonadHandler m
@@ -370,8 +402,9 @@ examTemplate :: MonadHandler m
 examTemplate cid = runMaybeT $ do
   newCourse <- MaybeT $ get cid
 
-  [(Entity _ oldCourse, Entity oldExamId oldExam)] <- lift . E.select . E.from $ \(course `E.InnerJoin` exam) -> do
+  [(Entity _ oldCourse, Entity oldExamId oldExam, mOldExamAuthorshipStatement)] <- lift . E.select . E.from $ \(course `E.InnerJoin` (exam `E.LeftOuterJoin` authorshipStatementDefinition)) -> do
     E.on $ course E.^. CourseId E.==. exam E.^. ExamCourse
+    E.on $ exam E.^. ExamAuthorshipStatement E.==. authorshipStatementDefinition E.?. AuthorshipStatementDefinitionId
     E.where_ $ (       course E.^. CourseShorthand E.==. E.val (courseShorthand newCourse)
                  E.||. course E.^. CourseName E.==. E.val (courseName newCourse)
                )
@@ -382,7 +415,7 @@ examTemplate cid = runMaybeT $ do
     E.where_ . E.not_ . E.isNothing $ exam E.^. ExamVisibleFrom
     E.limit 1
     E.orderBy [ E.desc $ course E.^. CourseTerm, E.asc $ exam E.^. ExamVisibleFrom ]
-    return (course, exam)
+    return (course, exam, authorshipStatementDefinition)
   
   extraSchools <- lift $ selectList [ ExamOfficeSchoolExam ==. oldExamId ] []
 
@@ -415,6 +448,7 @@ examTemplate cid = runMaybeT $ do
     , efExamMode         = examExamMode oldExam
     , efStaff            = examStaff oldExam
     , efOfficeSchools    = Set.fromList $ examOfficeSchoolSchool . entityVal <$> extraSchools
+    , efAuthorshipStatement = authorshipStatementDefinitionContent . entityVal <$> mOldExamAuthorshipStatement
     }
 
 

src/Handler/Exam/New.hs

@@ -29,6 +29,8 @@ postCExamNewR tid ssh csh = do
     newExamAct <- formResultMaybe newExamResult $ \ExamForm{..} -> do
       now <- liftIO getCurrentTime
 
+      examAuthorshipStatement <- traverse insertAuthorshipStatement efAuthorshipStatement
+
       insertRes <- insertUnique Exam
         { examName                         = efName
         , examCourse                       = cid
@@ -51,6 +53,7 @@ postCExamNewR tid ssh csh = do
         , examExamMode                     = efExamMode
         , examStaff                        = efStaff
         , examPartsFrom                    = efPartsFrom
+        , examAuthorshipStatement
         }
       whenIsJust insertRes $ \examid -> do
         insertMany_

src/Handler/ExamOffice/Users.hs

@@ -101,7 +101,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do
           | null newUsers
             -> pure oldUsers
           | otherwise
-            -> pure . nub $ oldUsers ++ Set.toList newUsers
+            -> pure . nubOrd $ oldUsers ++ Set.toList newUsers
       return (res', $(widgetFile "widgets/massinput/examOfficeUsers/add"))
     miCell' :: Either UserEmail UserId -> Widget
     miCell' (Left email) = do

src/Handler/ExternalExam/Form.hs

@@ -46,7 +46,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
       adminSchools <- filterM (hasWriteAccessTo . flip SchoolR SchoolEditR) protoAdminSchools
       let oldSchool = eefSchool <$> template
       return (lecturerSchools, adminSchools, oldSchool)
-  let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
+  let userSchools = nubOrd . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
       templateSchool = eefSchool <$> template <|> case userSchools of
         [ssh] -> pure ssh
         _     -> mzero

src/Handler/Material.hs

@@ -18,6 +18,7 @@ import qualified Data.CaseInsensitive as CI
 -- import qualified Data.Text.Encoding as Text
 
 import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
 
 import Utils.Form
 import Handler.Utils
@@ -97,12 +98,21 @@ getMaterialListR tid ssh csh = do
   MsgRenderer mr <- getMsgRenderer
   table <- runDB $ do
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+    let typeOptions :: HandlerFor UniWorX (OptionList Text)
+        typeOptions = do
+          previouslyUsed <- runDB $
+            E.select $ E.from $ \material ->
+              E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do
+                E.where_ $ material E.^. MaterialCourse E.==. E.val cid
+                    E.&&. E.not_ (E.isNothing $ material E.^. MaterialType)
+                return $ material E.^. MaterialType
+          return . mkOptionList . map (\(CI.original -> t) -> Option t t t) . Set.toAscList . Set.fromList $ mapMaybe E.unValue previouslyUsed
     let row2material = view $ _dbrOutput . _1 . _entityVal
         psValidator  = def & defaultSorting [SortDescBy "last-edit"]
                            & forceFilter "may-access" (Any True)
     dbTableWidget' psValidator DBTable
       { dbtIdent     = "material-list" :: Text
-      , dbtStyle     = def
+      , dbtStyle     = def { dbsFilterLayout = defaultDBSFilterLayout } 
       , dbtParams    = def
       , dbtSQLQuery  = \material -> do 
           E.where_ $ material E.^. MaterialCourse  E.==.  E.val cid
@@ -140,8 +150,17 @@ getMaterialListR tid ssh csh = do
       , dbtFilter    = mconcat
         [ singletonMap "may-access" . mkFilterProjectedPost $ \(Any b) dbr
             -> (== b) <$> hasReadAccessTo (matLink . materialName $ row2material dbr) :: DB Bool
+        , singletonMap "name". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of
+              Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
+              Just needle -> E.castString (material E.^. MaterialName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
+        , singletonMap "type-and-description". FilterColumn $ \material criterion -> case getLast (criterion :: Last Text) of
+              Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
+              Just needle -> (E.maybe (E.val mempty) E.castString (material E.^. MaterialType) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+                       E.||. (E.maybe (E.val mempty) (E.castString.esqueletoMarkupOutput) (material E.^. MaterialDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))   
         ]
-      , dbtFilterUI  = mempty
+      , dbtFilterUI  = \mPrev -> mconcat $ catMaybes
+        [ Just  $ prismAForm (singletonFilter "name") mPrev $ aopt textField (fslI MsgFilterMaterialNameSearch)
+        , Just  $ prismAForm (singletonFilter "type-and-description") mPrev $ aopt (textField & addDatalist typeOptions) (fslI MsgFilterMaterialTypeAndDescriptionSearch)]
       , dbtCsvEncode  = noCsvEncode
       , dbtCsvDecode  = Nothing
       , dbtExtraReps = []
@@ -389,4 +408,3 @@ getMArchiveR tid ssh csh mnm = do
 
   let getMatQuery = materialArchiveSource tid ssh csh mnm
   serveSomeFiles archiveName getMatQuery
-

src/Handler/Metrics.hs

@@ -44,7 +44,7 @@ getMetricsR = selectRep $ do
              -> suffix
       | otherwise
       = sName
-    getLabels = nub . concatMap (\(Sample _ lPairs _) -> lPairs ^.. folded . _1)
+    getLabels = nubOrd . concatMap (\(Sample _ lPairs _) -> lPairs ^.. folded . _1)
     singleSample base [Sample sName lPairs sValue]
       | sName == base = Just (lPairs, sValue)
     singleSample _ _ = Nothing

src/Handler/School.hs

@@ -68,6 +68,12 @@ data SchoolForm = SchoolForm
   , sfExamRequireModeForRegistration :: Bool
   , sfExamDiscouragedModes :: ExamModeDNF
   , sfExamCloseMode :: ExamCloseMode
+  , sfSheetAuthorshipStatementMode :: SchoolAuthorshipStatementMode
+  , sfSheetAuthorshipStatementDefinition :: Maybe I18nStoredMarkup
+  , sfSheetAuthorshipStatementAllowOther :: Bool
+  , sfSheetExamAuthorshipStatementMode :: SchoolAuthorshipStatementMode
+  , sfSheetExamAuthorshipStatementDefinition :: Maybe I18nStoredMarkup
+  , sfSheetExamAuthorshipStatementAllowOther :: Bool
   }
 
 mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
@@ -75,11 +81,20 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
   <$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh (textField & cfStrip & cfCI) (fslI MsgSchoolShort)
   <*> areq (textField & cfStrip & cfCI) (fslI MsgSchoolName) (sfName <$> template)
   <*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip . CI.original) <$> massInputListA (ciField & addDatalist ldapOrgs) (const "") MsgSchoolLdapOrganisationMissing (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (Set.toList . sfOrgUnits <$> template))
+  <*  aformSection MsgSchoolExamSection
   <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterBeforeStart & setTooltip MsgSchoolExamMinimumRegisterBeforeStartTip) (sfExamMinimumRegisterBeforeStart <$> template)
   <*> aopt daysField (fslI MsgSchoolExamMinimumRegisterDuration & setTooltip MsgSchoolExamMinimumRegisterDurationTip) (sfExamMinimumRegisterDuration <$> template)
   <*> apopt checkBoxField (fslI MsgSchoolExamRequireModeForRegistration & setTooltip MsgSchoolExamRequireModeForRegistration) (sfExamRequireModeForRegistration <$> template)
-  <*> areq pathPieceField (fslI MsgSchoolExamDiscouragedModes) (sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse))
+  <*> (fromMaybe (ExamModeDNF predDNFFalse) <$> aopt pathPieceField (fslI MsgSchoolExamDiscouragedModes) (Just $ sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse)))
   <*> apopt (selectField optionsFinite) (fslI MsgExamCloseMode) (sfExamCloseMode <$> template <|> pure ExamCloseSeparate)
+  <*  aformSection MsgSchoolAuthorshipStatementSection
+  <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetMode) (sfSheetAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional)
+  <*> i18nFieldA htmlField False (\_ -> Nothing) ("sheet-authorship-statement-definition" :: Text) (fslI MsgSchoolAuthorshipStatementSheetDefinition & setTooltip MsgSchoolAuthorshipStatementSheetDefinitionTip) False (sfSheetAuthorshipStatementDefinition <$> template)
+  <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetAllowOther) (sfSheetAuthorshipStatementAllowOther <$> template <|> pure True)
+  <*> apopt (selectField optionsFinite) (fslI MsgSchoolAuthorshipStatementSheetExamMode) (sfSheetExamAuthorshipStatementMode <$> template <|> pure SchoolAuthorshipStatementModeOptional)
+  <*> i18nFieldA htmlField False (\_ -> Nothing) ("exam-authorship-statement-definition" :: Text) (fslI MsgSchoolAuthorshipStatementSheetExamDefinition & setTooltip MsgSchoolAuthorshipStatementSheetExamDefinitionTip) False (sfSheetExamAuthorshipStatementDefinition <$> template)
+  <*> apopt checkBoxField (fslI MsgSchoolAuthorshipStatementSheetExamAllowOther) (sfSheetExamAuthorshipStatementAllowOther <$> template <|> pure True)
+  -- TODO(AuthorshipStatements): disallow not allowOther && is _Nothing definition
   where
     ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text))
     ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $
@@ -89,6 +104,10 @@ schoolToForm :: SchoolId -> DB (Form SchoolForm)
 schoolToForm ssh = do
   School{..} <- get404 ssh
   ldapFrags <- selectList [SchoolLdapSchool ==. Just ssh] []
+
+  mSheetAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetAuthorshipStatementDefinition
+  mSheetExamAuthorshipStatementDefinition <- maybe (return Nothing) get schoolSheetExamAuthorshipStatementDefinition
+
   return . mkSchoolForm (Just ssh) $ Just SchoolForm
     { sfShorthand = schoolShorthand
     , sfName = schoolName
@@ -98,9 +117,14 @@ schoolToForm ssh = do
     , sfExamRequireModeForRegistration = schoolExamRequireModeForRegistration
     , sfExamDiscouragedModes = schoolExamDiscouragedModes
     , sfExamCloseMode = schoolExamCloseMode
+    , sfSheetAuthorshipStatementMode = schoolSheetAuthorshipStatementMode
+    , sfSheetAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mSheetAuthorshipStatementDefinition
+    , sfSheetAuthorshipStatementAllowOther = schoolSheetAuthorshipStatementAllowOther
+    , sfSheetExamAuthorshipStatementMode = schoolSheetExamAuthorshipStatementMode
+    , sfSheetExamAuthorshipStatementDefinition = authorshipStatementDefinitionContent <$> mSheetExamAuthorshipStatementDefinition
+    , sfSheetExamAuthorshipStatementAllowOther = schoolSheetExamAuthorshipStatementAllowOther
     }
 
-
 getSchoolEditR, postSchoolEditR :: SchoolId -> Handler Html
 getSchoolEditR = postSchoolEditR
 postSchoolEditR ssh = do
@@ -110,6 +134,8 @@ postSchoolEditR ssh = do
 
   formResult sfResult $ \SchoolForm{..} -> do
     runDB $ do
+      mSheetAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetAuthorshipStatementDefinition
+      mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
       update ssh
         [ SchoolName =. sfName
         , SchoolExamMinimumRegisterBeforeStart =. sfExamMinimumRegisterBeforeStart
@@ -117,6 +143,12 @@ postSchoolEditR ssh = do
         , SchoolExamRequireModeForRegistration =. sfExamRequireModeForRegistration
         , SchoolExamDiscouragedModes =. sfExamDiscouragedModes
         , SchoolExamCloseMode =. sfExamCloseMode
+        , SchoolSheetAuthorshipStatementMode =. sfSheetAuthorshipStatementMode
+        , SchoolSheetAuthorshipStatementDefinition =. mSheetAuthorshipStatementId
+        , SchoolSheetAuthorshipStatementAllowOther =. sfSheetAuthorshipStatementAllowOther
+        , SchoolSheetExamAuthorshipStatementMode =. sfSheetExamAuthorshipStatementMode
+        , SchoolSheetExamAuthorshipStatementDefinition =. mSheetExamAuthorshipStatementId
+        , SchoolSheetExamAuthorshipStatementAllowOther =. sfSheetExamAuthorshipStatementAllowOther
         ]
       forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
         void $ upsert SchoolLdap
@@ -151,6 +183,8 @@ postSchoolNewR = do
   formResult sfResult $ \SchoolForm{..} -> do
     let ssh = SchoolKey sfShorthand
     insertOkay <- runDB $ do
+      mSheetAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
+      mSheetExamAuthorshipStatementId <- traverse insertAuthorshipStatement sfSheetExamAuthorshipStatementDefinition
       didInsert <- is _Just <$> insertUnique School
         { schoolShorthand = sfShorthand
         , schoolName = sfName
@@ -159,6 +193,12 @@ postSchoolNewR = do
         , schoolExamRequireModeForRegistration = sfExamRequireModeForRegistration
         , schoolExamDiscouragedModes = sfExamDiscouragedModes
         , schoolExamCloseMode = sfExamCloseMode
+        , schoolSheetAuthorshipStatementMode = sfSheetAuthorshipStatementMode
+        , schoolSheetAuthorshipStatementDefinition = mSheetAuthorshipStatementId
+        , schoolSheetAuthorshipStatementAllowOther = sfSheetAuthorshipStatementAllowOther
+        , schoolSheetExamAuthorshipStatementMode = sfSheetExamAuthorshipStatementMode
+        , schoolSheetExamAuthorshipStatementDefinition = mSheetExamAuthorshipStatementId
+        , schoolSheetExamAuthorshipStatementAllowOther = sfSheetExamAuthorshipStatementAllowOther
         }
       when didInsert $ do
         insert_ UserFunction

src/Handler/Sheet/Edit.hs

@@ -22,14 +22,20 @@ import Handler.Sheet.PersonalisedFiles
 getSEditR, postSEditR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSEditR = postSEditR
 postSEditR tid ssh csh shn = do
-  (Entity sid Sheet{..}, sheetFileIds, currentLoads, hasPersonalisedFiles) <- runDB $ do
+  (Entity sid Sheet{..}, sheetFileIds, currentLoads, hasPersonalisedFiles, mAuthorshipStatement) <- runDB $ do
-    ent@(Entity sid _) <- fetchSheet tid ssh csh shn
+    ent@(Entity sid oldSheet) <- fetchSheet tid ssh csh shn
     fti <- getFtIdMap $ entityKey ent
     cLoads <- Map.union
       <$> fmap (foldMap $ \(Entity _ SheetCorrector{..}) -> Map.singleton (Right sheetCorrectorUser) (InvDBDataSheetCorrector sheetCorrectorLoad sheetCorrectorState, InvTokenDataSheetCorrector)) (selectList [ SheetCorrectorSheet ==. sid ] [])
       <*> fmap (fmap (, InvTokenDataSheetCorrector) . Map.mapKeysMonotonic Left) (sourceInvitationsF sid)
     hasPersonalisedFiles <- exists [ PersonalisedSheetFileSheet ==. sid ]
-    return (ent, fti, cLoads, hasPersonalisedFiles)
+    -- TODO: update statement if school authorship statement was updated?
+    -- mSchoolAuthorshipStatement <- runMaybeT $ do
+    --   Entity _ School{..} <- MaybeT . getEntity $ ssh
+    --   definitionId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition
+    --   MaybeT . getEntity $ definitionId
+    mAuthorshipStatement <- maybe (pure Nothing) getEntity (oldSheet ^. _sheetAuthorshipStatement)
+    return (ent, fti, cLoads, hasPersonalisedFiles, mAuthorshipStatement)
   let template = Just $ SheetForm
         { sfName           = sheetName
         , sfDescription    = sheetDescription
@@ -55,6 +61,9 @@ postSEditR tid ssh csh shn = do
           , spffAllowNonPersonalisedSubmission = sheetAllowNonPersonalisedSubmission
           , spffFiles = Nothing
           }
+        , sfAuthorshipStatementMode = sheetAuthorshipStatementMode
+        , sfAuthorshipStatementExam = sheetAuthorshipStatementExam
+        , sfAuthorshipStatement = authorshipStatementDefinitionContent . entityVal <$> mAuthorshipStatement
         }
 
   let action = uniqueReplace sid -- More specific error message for edit old sheet could go here by using myReplaceUnique instead
@@ -70,6 +79,33 @@ handleSheetEdit tid ssh csh msId template dbAction = do
     (FormSuccess SheetForm{..}) -> do
       saveOkay <- runDBJobs $ do
         actTime <- liftIO getCurrentTime
+
+       -- let insertNewOrKeepStatement = \case
+       --       -- statement disabled:
+       --       Nothing -> pure Nothing
+       --       -- use school preset (i.e. return the id of a *copy*):
+       --       Just Nothing -> runMaybeT $ do
+       --         Entity _ School{..} <- MaybeT . getEntity $ ssh
+       --         schoolStatementId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition
+       --         Entity _ AuthorshipStatementDefinition{..} <- MaybeT . getEntity $ schoolStatementId
+       --         lift . insert $ AuthorshipStatementDefinition authorshipStatementDefinitionContent
+       --       -- use custom statement:
+       --       Just (Just newContent) -> do
+       --         mOldAuthorshipStatement <- runMaybeT $ do
+       --           sId <- MaybeT . return $ msId
+       --           Entity _ Sheet{..} <- MaybeT . getEntity $ sId
+       --           statementId <- MaybeT . return $ sheetAuthorshipStatement
+       --           MaybeT . getEntity $ statementId
+       --         if
+       --           -- statement modified: insert new statement
+       --           | maybe True ((/=) newContent . authorshipStatementDefinitionContent . entityVal) mOldAuthorshipStatement
+       --           -> Just <$> (insert $ AuthorshipStatementDefinition newContent)
+       --           -- statement not modified: return id of old statement
+       --           | otherwise -> return $ entityKey <$> mOldAuthorshipStatement
+       -- mNewAuthorshipStatementId <- insertNewOrKeepStatement sfAuthorshipStatement
+  
+        sheetAuthorshipStatement <- traverse insertAuthorshipStatement sfAuthorshipStatement
+
         let newSheet = Sheet
               { sheetCourse         = cid
               , sheetName           = sfName
@@ -87,6 +123,9 @@ handleSheetEdit tid ssh csh msId template dbAction = do
               , sheetAnonymousCorrection = sfAnonymousCorrection
               , sheetRequireExamRegistration = sfRequireExamRegistration
               , sheetAllowNonPersonalisedSubmission = maybe True spffAllowNonPersonalisedSubmission sfPersonalF
+              , sheetAuthorshipStatementMode = sfAuthorshipStatementMode
+              , sheetAuthorshipStatementExam = sfAuthorshipStatementExam
+              , sheetAuthorshipStatement
               }
         mbsid <- dbAction newSheet
         case mbsid of

src/Handler/Sheet/Form.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
 module Handler.Sheet.Form
   ( SheetForm(..), SheetPersonalisedFilesForm(..), Loads
   , makeSheetForm
@@ -10,6 +12,7 @@ import Handler.Utils
 import Handler.Utils.Invitations
 
 import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
@@ -42,7 +45,9 @@ data SheetForm = SheetForm
       , sfMarkingText  :: Maybe StoredMarkup
       , sfAnonymousCorrection :: Bool
       , sfCorrectors   :: Loads
-      -- Keine SheetId im Formular!
+      , sfAuthorshipStatementMode :: SheetAuthorshipStatementMode
+      , sfAuthorshipStatementExam :: Maybe ExamId
+      , sfAuthorshipStatement :: Maybe I18nStoredMarkup
       }
 
 data SheetPersonalisedFilesForm = SheetPersonalisedFilesForm
@@ -64,40 +69,123 @@ makeSheetForm cId msId template = identifyForm FIDsheet . validateForm validateS
     oldFileIds <- (return.) <$> case msId of
       Nothing    -> return $ partitionFileType mempty
       (Just sId) -> liftHandler $ runDB $ getFtIdMap sId
-    MsgRenderer mr <- getMsgRenderer
+    mr'@(MsgRenderer mr) <- getMsgRenderer
     ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
+    ((School{..}, mSchoolAuthorshipStatement), _course) <- liftHandler . runDB $ do
+      course@Course{courseSchool} <- get404 cId
+      school@School{..} <- get404 courseSchool
+      mSchoolAuthorshipStatement <- runMaybeT $ do
+        statementId <- MaybeT . return $ schoolSheetAuthorshipStatementDefinition
+        MaybeT . getEntity $ statementId
+      return ((school, mSchoolAuthorshipStatement), course)
     sheetPersonalisedFilesForm <- makeSheetPersonalisedFilesForm $ template >>= sfPersonalF
-    flip (renderAForm FormStandard) html $ SheetForm
+
-      <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName)         (sfName        <$> template)
+    let mkSheetForm 
-      <*> aopt htmlField      (fslI MsgSheetDescription) (sfDescription <$> template)
+          sfName
+          sfDescription
+          sfRequireExamRegistration
+          sfSheetF sfHintF sfSolutionF sfMarkingF
+          sfPersonalF sfVisibleFrom sfActiveFrom sfActiveTo sfHintFrom sfSolutionFrom
+          sfSubmissionMode sfGrouping sfType
+          sfAutoDistribute sfMarkingText sfAnonymousCorrection sfCorrectors
+          (sfAuthorshipStatementMode, sfAuthorshipStatementExam, sfAuthorshipStatement)
+            = SheetForm{..}
+
+    flip (renderAForm FormStandard) html $ mkSheetForm
+      <$> areq (textField & cfStrip & cfCI) (fslI MsgSheetName) (sfName <$> template)
+      <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template)
       <*> optionalActionA (apreq (examField Nothing cId) (fslI MsgSheetRequiredExam) (sfRequireExamRegistration =<< template)) (fslI MsgSheetRequireExam & setTooltip MsgSheetRequireExamTip) (is _Just . sfRequireExamRegistration <$> template)
-      <* aformSection MsgSheetFormFiles
+
+      <*  aformSection MsgSheetFormFiles
       <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template)
-      <*> aopt (multiFileField $ oldFileIds SheetHint)     (fslI MsgSheetHint)      (sfHintF <$> template)
+      <*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template)
       <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
-      <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarkingFiles
+      <*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarkingFiles & setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template)
-            & setTooltip MsgSheetMarkingTip)                  (sfMarkingF <$> template)
       <*> optionalActionA sheetPersonalisedFilesForm (fslI MsgSheetPersonalisedFiles & setTooltip MsgSheetPersonalisedFilesTip) (is _Just . sfPersonalF <$> template)
-      <* aformSection MsgSheetFormTimes
+
-      <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
+      <*  aformSection MsgSheetFormTimes
-            & setTooltip MsgSheetVisibleFromTip)
+      <*> aopt utcTimeField (fslI MsgSheetVisibleFrom & setTooltip MsgSheetVisibleFromTip) ((sfVisibleFrom <$> template) <|> pure (Just ctime))
-                                                              ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
+      <*> aopt utcTimeField (fslI MsgSheetActiveFrom & setTooltip MsgSheetActiveFromTip) (sfActiveFrom <$> template)
-      <*> aopt utcTimeField   (fslI MsgSheetActiveFrom
+      <*> aopt utcTimeField (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template)
-            & setTooltip MsgSheetActiveFromTip)
+      <*> aopt utcTimeField (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder) & setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template)
-                                                              (sfActiveFrom   <$> template)
+      <*> aopt utcTimeField (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder) & setTooltip MsgSheetSolutionFromTip) (sfSolutionFrom <$> template)
-      <*> aopt utcTimeField   (fslI MsgSheetActiveTo & setTooltip MsgSheetActiveToTip) (sfActiveTo <$> template)
+
-      <*> aopt utcTimeField   (fslpI MsgSheetHintFrom (mr MsgSheetHintFromPlaceholder)
+      <*  aformSection MsgSheetFormType
-            & setTooltip MsgSheetHintFromTip)                 (sfHintFrom     <$> template)
-      <*> aopt utcTimeField   (fslpI MsgSheetSolutionFrom (mr MsgSheetSolutionFromPlaceholder)
-            & setTooltip MsgSheetSolutionFromTip)             (sfSolutionFrom <$> template)
-      <* aformSection MsgSheetFormType
       <*> submissionModeForm ((sfSubmissionMode <$> template) <|> pure (SubmissionMode False . Just $ UploadAny True defaultExtensionRestriction False))
-      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        ((sfGrouping <$> template) <|> pure NoGroups)
+      <*> sheetGroupAFormReq (fslI MsgSheetGroup) ((sfGrouping <$> template) <|> pure NoGroups)
       <*> sheetTypeAFormReq cId (fslI MsgSheetSheetType) (sfType <$> template)
+
       <*> apopt checkBoxField (fslI MsgAutoAssignCorrs) (sfAutoDistribute <$> template)
-      <*> aopt htmlField    (fslI MsgSheetMarking) (sfMarkingText <$> template)
+      <*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template)
       <*> apopt checkBoxField (fslI MsgSheetAnonymousCorrection & setTooltip MsgSheetAnonymousCorrectionTip) (sfAnonymousCorrection <$> template)
       <*> correctorForm (maybe mempty sfCorrectors template)
+
+      <*> let sfAuthorshipStatementExam' = sfAuthorshipStatementExam =<< template
+              sfAuthorshipStatement' = sfAuthorshipStatement =<< template
+           in wFormToAForm $ (\res -> (,,) <$> view _1 res <*> view _2 res <*> view _3 res) <$>
+                if | isn't _SchoolAuthorshipStatementModeNone schoolSheetAuthorshipStatementMode -> do
+                       wformSection MsgSheetAuthorshipStatementSection
+
+                       let 
+                         reqContentField :: AForm Handler I18nStoredMarkup
+                         reqContentField = formResultUnOpt mr' MsgSheetAuthorshipStatementContent
+                               `fmapAForm` i18nFieldA htmlField True (\_ -> Nothing) ("authorship-statement" :: Text)
+                                           (fslI MsgSheetAuthorshipStatementContent)
+                                           True
+                                           ( fmap Just $     (sfAuthorshipStatement =<< template)
+                                                         <|> (authorshipStatementDefinitionContent . entityVal <$> mSchoolAuthorshipStatement)
+                                           )
+                         forcedContentField = wforced forcedAuthorshipStatementField (fslI MsgSheetAuthorshipStatementContent & setTooltip MsgSheetAuthorshipStatementContentForcedTip)
+
+                       if | not schoolSheetAuthorshipStatementAllowOther
+                            -> (pure SheetAuthorshipStatementModeEnabled, pure sfAuthorshipStatementExam', )
+                               <$> (fmap (traverse $ fmap authorshipStatementDefinitionContent) . traverse forcedContentField $ entityVal <$> mSchoolAuthorshipStatement)
+                          | otherwise -> do
+                              examOpts <-
+                                let examFieldQuery = E.from $ \exam -> do
+                                      E.where_ $ exam E.^. ExamCourse E.==. E.val cId
+                                      when (is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode) $
+                                        E.where_ . E.isJust $ exam E.^. ExamAuthorshipStatement
+                                      return exam
+                                 in liftHandler $ optionsCryptoIdE examFieldQuery examName
+
+                              let modeOpts = case schoolSheetAuthorshipStatementMode of
+                                    SchoolAuthorshipStatementModeNone -> Set.singleton SheetAuthorshipStatementModeDisabled
+                                    SchoolAuthorshipStatementModeOptional -> Set.fromList universeF
+                                    SchoolAuthorshipStatementModeRequired -> Set.fromList universeF
+                                      & Set.delete SheetAuthorshipStatementModeDisabled
+                                      & bool id (Set.delete SheetAuthorshipStatementModeExam) (hasn't (_olOptions . folded) examOpts)
+                                  modeOpts' = explainOptionList (optionsPathPiece . map (id &&& id) $ Set.toList modeOpts) $ \case
+                                    SheetAuthorshipStatementModeDisabled -> return $(i18nWidgetFile "sheet-authorship-statement-mode-tip/disabled")
+                                    SheetAuthorshipStatementModeExam -> return $(i18nWidgetFile "sheet-authorship-statement-mode-tip/exam")
+                                    SheetAuthorshipStatementModeEnabled -> return $(i18nWidgetFile "sheet-authorship-statement-mode-tip/enabled")
+                                  examField' = selectField' (Just $ SomeMessage MsgSheetAuthorshipStatementExamNone) . return $ entityKey <$> examOpts
+                                  examField'' :: AForm Handler (Maybe ExamId)
+                                  examField''
+                                    | isn't _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode
+                                    = aopt examField' (fslI MsgSheetAuthorshipStatementExam) (sfAuthorshipStatementExam <$> template)
+                                    | otherwise
+                                    = Just <$> apreq examField' (fslI MsgSheetAuthorshipStatementExam) (sfAuthorshipStatementExam =<< template)
+                                  modeForms = flip Map.fromSet modeOpts $ \case
+                                    SheetAuthorshipStatementModeDisabled -> pure
+                                      ( SheetAuthorshipStatementModeDisabled
+                                      , sfAuthorshipStatementExam'
+                                      , sfAuthorshipStatement'
+                                      )
+                                    SheetAuthorshipStatementModeExam -> (SheetAuthorshipStatementModeExam,, )
+                                      <$> examField''
+                                      <*> pure sfAuthorshipStatement'
+                                    SheetAuthorshipStatementModeEnabled -> (SheetAuthorshipStatementModeEnabled, sfAuthorshipStatementExam', )
+                                      <$> fmap Just reqContentField
+
+                                  massage res = (view _1 <$> res, view _2 <$> res, view _3 <$> res)
+
+                              massage <$> explainedMultiActionW modeForms modeOpts' (fslI MsgSheetAuthorshipStatementRequired & setTooltip (bool MsgSheetAuthorshipStatementRequiredTip MsgSheetAuthorshipStatementRequiredForcedTip $ is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode)) (sfAuthorshipStatementMode <$> template)
+                   | otherwise -> return
+                       ( pure SheetAuthorshipStatementModeDisabled
+                       , pure sfAuthorshipStatementExam'
+                       , pure sfAuthorshipStatement'
+                       )
   where
     makeSheetPersonalisedFilesForm :: Maybe SheetPersonalisedFilesForm -> MForm Handler (AForm Handler SheetPersonalisedFilesForm)
     makeSheetPersonalisedFilesForm template' = do
@@ -181,10 +269,11 @@ correctorForm loads' = wFormToAForm $ do
 
     miAdd :: ListPosition
           -> Natural
+          -> ListLength
           -> (Text -> Text)
           -> FieldView UniWorX
           -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
-    miAdd _ _ nudge submitView = Just $ \csrf -> do
+    miAdd _ _ _ nudge submitView = Just $ \csrf -> do
       (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just previousCorrectors) (fslpI MsgSheetCorrector (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "corrector")) Nothing
       let addRes' = addRes <&> \nCorrs oldData@(maybe 0 (succ . fst) . Map.lookupMax -> kStart) -> if
             | existing <- Set.intersection nCorrs . Set.fromList $ Map.elems oldData
@@ -225,12 +314,6 @@ correctorForm loads' = wFormToAForm $ do
              -> MaybeT (MForm Handler) (Map ListPosition ListPosition)
     miDelete = miDeleteList
 
-    miAllowAdd :: ListPosition
-               -> Natural
-               -> ListLength
-               -> Bool
-    miAllowAdd _ _ _ = True
-
     miAddEmpty :: ListPosition
                -> Natural
                -> ListLength

src/Handler/Sheet/New.hs

@@ -25,8 +25,9 @@ postSheetNewR tid ssh csh = do
   let searchShn sheet = case parShn of
         (FormSuccess (Just shn)) -> E.where_ $ sheet E.^. SheetName E.==. E.val shn
         _other -> return ()
-  (lastSheets, loads) <- runDB $ do
+  now <- liftIO getCurrentTime
-    lSheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
+  template <- runDB $ do
+    lastSheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
       E.on     $ course E.^. CourseId E.==. sheet E.^. SheetCourse
       E.where_ $ course E.^. CourseTerm      E.==. E.val tid
           E.&&.  course E.^. CourseSchool    E.==. E.val ssh
@@ -34,40 +35,41 @@ postSheetNewR tid ssh csh = do
       searchShn sheet
       E.orderBy [E.desc (sheet E.^. SheetActiveFrom)]
       E.limit 1
-      let firstEdit = E.subSelectMaybe . E.from $ \sheetEdit -> do
+      let
-            E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
+        firstEdit = E.subSelectMaybe . E.from $ \sheetEdit -> do
-            return . E.min_ $ sheetEdit E.^. SheetEditTime
+          E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
+          return . E.min_ $ sheetEdit E.^. SheetEditTime
       return (sheet, firstEdit)
     cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
     loads <- defaultLoads cid
-    return (lSheets, loads)
+    for (lastSheets ^? _head) $ \(Entity _ Sheet{..}, E.Value fEdit) -> do
-  now <- liftIO getCurrentTime
+      let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now
-  let template = case lastSheets of
+      mStmt <- traverse getJust sheetAuthorshipStatement
-        ((Entity {entityVal=Sheet{..}}, E.Value fEdit):_)  ->
+      return SheetForm
-          let addTime = addWeeks $ max 1 $ weeksToAdd (fromMaybe (UTCTime systemEpochDay 0) $ sheetActiveTo <|> fEdit) now
+        { sfName           = stepTextCounterCI sheetName
-          in Just $ SheetForm
+        , sfDescription    = sheetDescription
-            { sfName           = stepTextCounterCI sheetName
+        , sfType           = review _SqlKey <$> sheetType
-            , sfDescription    = sheetDescription
+        , sfGrouping       = sheetGrouping
-            , sfType           = review _SqlKey <$> sheetType
+        , sfVisibleFrom    = addTime <$> sheetVisibleFrom
-            , sfGrouping       = sheetGrouping
+        , sfActiveFrom     = addTime <$> sheetActiveFrom
-            , sfVisibleFrom    = addTime <$> sheetVisibleFrom
+        , sfActiveTo       = addTime <$> sheetActiveTo
-            , sfActiveFrom     = addTime <$> sheetActiveFrom
+        , sfSubmissionMode = sheetSubmissionMode
-            , sfActiveTo       = addTime <$> sheetActiveTo
+        , sfSheetF         = Nothing
-            , sfSubmissionMode = sheetSubmissionMode
+        , sfHintFrom       = addTime <$> sheetHintFrom
-            , sfSheetF         = Nothing
+        , sfHintF          = Nothing
-            , sfHintFrom       = addTime <$> sheetHintFrom
+        , sfSolutionFrom   = addTime <$> sheetSolutionFrom
-            , sfHintF          = Nothing
+        , sfSolutionF      = Nothing
-            , sfSolutionFrom   = addTime <$> sheetSolutionFrom
+        , sfMarkingF       = Nothing
-            , sfSolutionF      = Nothing
+        , sfMarkingText    = sheetMarkingText
-            , sfMarkingF       = Nothing
+        , sfAutoDistribute = sheetAutoDistribute
-            , sfMarkingText    = sheetMarkingText
+        , sfCorrectors     = loads
-            , sfAutoDistribute = sheetAutoDistribute
+        , sfAnonymousCorrection = sheetAnonymousCorrection
-            , sfCorrectors     = loads
+        , sfRequireExamRegistration = Nothing
-            , sfAnonymousCorrection = sheetAnonymousCorrection
+        , sfPersonalF      = Nothing
-            , sfRequireExamRegistration = Nothing
+        , sfAuthorshipStatementMode = sheetAuthorshipStatementMode
-            , sfPersonalF      = Nothing
+        , sfAuthorshipStatementExam = sheetAuthorshipStatementExam
-            }
+        , sfAuthorshipStatement = authorshipStatementDefinitionContent <$> mStmt
-        _other -> Nothing
+        }
   let action = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
         insertUnique
   handleSheetEdit tid ssh csh Nothing template action

src/Handler/Sheet/PersonalisedFiles.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Handler.Sheet.PersonalisedFiles
   ( sinkPersonalisedSheetFiles
   , getSPersonalFilesR, getCPersonalFilesR
@@ -74,6 +76,9 @@ data PersonalisedSheetFilesForm = PersonalisedSheetFilesForm
   } deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
+embedRenderMessage ''UniWorX ''PersonalisedSheetFilesDownloadAnonymous id
+
+
 personalisedSheetFileTypes :: [SheetFileType]
 personalisedSheetFileTypes = filter (/= SheetMarking) universeF
 
@@ -103,8 +108,8 @@ resolvePersonalisedSheetFiles fpL isDir cid sid = do
                   let
                     getUid :: _ -> _ -> MemoStateT _ _ _ (SqlPersistT m) (Maybe UserId)
                     getUid mbIdx' cID' = runMaybeT $ do
-                      cIDKey <- catchMPlus (Proxy @PersonalisedSheetFilesKeyException) . lift . lift $ getPersonalisedFilesKey cid (Just sid) mbIdx'
+                      kSet <- catchMPlus (Proxy @PersonalisedSheetFilesKeyException) . lift . lift $ getPersonalisedFilesKey cid (Just sid) mbIdx'
-                      uid <- either (const mzero) return . (runReaderT ?? cIDKey) $ I.decrypt cID'
+                      uid <- either (const mzero) return . (runReaderT ?? psfksCryptoID kSet) $ I.decrypt cID'
                       guardM . lift . lift $ exists [CourseParticipantUser ==. uid, CourseParticipantCourse ==. cid]
                       return uid
                         
@@ -166,7 +171,7 @@ sinkPersonalisedSheetFiles cid sid keep
            Right nSink -> State.modify . Map.insert redResidual $ Map.insert residual nSink sinks
      openSinks <- State.get
      lift . lift . mapM_ closeResumableSink $ openSinks ^.. folded . folded
-     let (nub -> sinkSheets, nub -> sinkUsers) = unzip $ Map.keys openSinks
+     let (nubOrd -> sinkSheets, nubOrd -> sinkUsers) = unzip $ Map.keys openSinks
      unless keep $
        lift . lift $ deleteWhere [ PersonalisedSheetFileSheet  <-. sinkSheets
                                  , PersonalisedSheetFileUser  /<-. sinkUsers
@@ -213,7 +218,7 @@ sourcePersonalisedSheetFiles :: forall m.
                              -> Set PersonalisedSheetFilesRestriction
                              -> ConduitT () (Either PersonalisedSheetFile DBFile) (SqlPersistT m) ()
 sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do
-  (mbIdx, cIDKey) <- lift . newPersonalisedFilesKey $ maybe (Left cId) Right mbsid
+  (mbIdx, kSet) <- lift . newPersonalisedFilesKey $ maybe (Left cId) Right mbsid
   let
     genSuffixes uid = case anonMode of
       PersonalisedSheetFilesDownloadGroups -> do
@@ -222,7 +227,7 @@ sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do
           E.where_ $ submissionGroup E.^. SubmissionGroupCourse E.==. E.val cId
           E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid
           return $ submissionGroup E.^. SubmissionGroupName
-        return . nub . sort $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) subGroups
+        return . Set.toList . Set.fromList $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) subGroups
       otherAnon
         | Just f <- userFeature otherAnon -> do
             features <- E.select . E.from $ \user -> do
@@ -260,7 +265,7 @@ sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do
             suf <- lift . lift $ genSuffixes courseParticipantUser
             _sufCache %= Map.insert courseParticipantUser suf
             return suf
-      cID <- throwLeft . (runReaderT ?? cIDKey) $ I.encrypt courseParticipantUser
+      cID <- throwLeft . (runReaderT ?? psfksCryptoID kSet) $ I.encrypt courseParticipantUser
       let dirName = unpack . Text.intercalate "_" . map pack $ suffix `snoc` mkPersonalisedFilesDirectory mbIdx cID
       unlessM (uses _dirCache $ Set.member dirName) $ do
         yield $ Right File
@@ -275,7 +280,8 @@ sourcePersonalisedSheetFiles cId mbsid mbuids anonMode restrs = do
             , fileModified = courseParticipantRegistration
             }
         yieldM . fmap Right $ do
-          fileContent' <- lift $ formatPersonalisedSheetFilesMeta anonMode cPart cID
+          mr' <- getMsgRenderer
+          fileContent' <- lift $ formatPersonalisedSheetFilesMeta mr' anonMode cPart cID (mkPersonalisedSheetFilesSeed <$> psfksSeed kSet)
           let fileTitle = (dirName <//>) . ensureExtension "yaml" . unpack . mr $ MsgPersonalisedSheetFilesMetaFilename cID
               fileModified = courseParticipantRegistration
               fileContent = Just $ C.sourceLazy fileContent'
@@ -307,21 +313,24 @@ newPersonalisedFilesKey :: forall m.
                            , HandlerSite m ~ UniWorX
                            , MonadThrow m, MonadRandom m
                            )
-                        => Either CourseId SheetId -> SqlPersistT m (Maybe Word24, CryptoIDKey)
+                        => Either CourseId SheetId -> SqlPersistT m (Maybe Word24, PersonalisedSheetFilesKeySet)
-newPersonalisedFilesKey (Right shId) = cryptoIDKey $ \cIDKey -> fmap (Nothing,) $
+newPersonalisedFilesKey (Right shId) = (Nothing, ) <$> do
-  either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict . BA.convert $
+  psfksCryptoID <- cryptoIDKey $ \cIDKey ->
-  Crypto.kmac @(SHAKE256 CryptoIDCipherKeySize) (encodeUtf8 . (pack :: String -> Text) $ nameBase 'newPersonalisedFilesKey) (toStrict $ Binary.encode shId) cIDKey
+    either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict . BA.convert $
+      Crypto.kmac @(SHAKE256 CryptoIDCipherKeySize) (encodeUtf8 . (pack :: String -> Text) $ nameBase 'newPersonalisedFilesKey) (toStrict $ Binary.encode shId) cIDKey
+  psfksSeed <- fmap Just . getsYesod . views _appPersonalisedSheetFilesSeedKey . flip derivePersonalisedSheetFilesSeedKey . toStrict $ Binary.encode (nameBase 'newPersonalisedFilesKey, shId)
+  return PersonalisedSheetFilesKeySet{..} 
 newPersonalisedFilesKey (Left cId) = do
   now <- liftIO getCurrentTime
   secret <- CryptoID.genKey
   let secret' = toStrict $ Binary.encode secret
   firstN <- getRandom
 
-  let loop :: Word24 -> SqlPersistT m (Maybe Word24, CryptoIDKey)
+  let loop :: Word24 -> SqlPersistT m (Maybe Word24, PersonalisedSheetFilesKeySet)
       loop n = do
         didInsert <- is _Just <$> insertUnique (FallbackPersonalisedSheetFilesKey cId n secret' now)
         if | didInsert
-             -> return (Just n, secret)
+             -> return (Just n, PersonalisedSheetFilesKeySet secret Nothing)
            |    (firstN == minBound && n == maxBound)
              || n == pred firstN
              -> throwM FallbackPersonalisedSheetFilesKeysExhausted
@@ -336,12 +345,13 @@ getPersonalisedFilesKey :: forall m.
                            , HandlerSite m ~ UniWorX
                            , MonadThrow m, MonadRandom m
                            )
-                        => CourseId -> Maybe SheetId -> Maybe Word24 -> SqlPersistT m CryptoIDKey
+                        => CourseId -> Maybe SheetId -> Maybe Word24 -> SqlPersistT m PersonalisedSheetFilesKeySet
 getPersonalisedFilesKey _    Nothing     Nothing   = throwM PersonalisedSheetFilesKeyInsufficientContext
 getPersonalisedFilesKey _   (Just shId)  Nothing   = view _2 <$> newPersonalisedFilesKey (Right shId)
 getPersonalisedFilesKey cId  _          (Just idx) = maybeT (throwM PersonalisedSheetFilesKeyNotFound) $ do
   Entity _ FallbackPersonalisedSheetFilesKey{..} <- MaybeT . getBy $ UniqueFallbackPersonalisedSheetFilesKey cId idx
-  either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail . fromStrict $ BA.convert fallbackPersonalisedSheetFilesKeySecret
+  psfksCryptoID <- either (const $ throwM PersonalisedSheetFilesKeyCouldNotDecodeRandom) (views _3 return) . Binary.decodeOrFail $ fromStrict fallbackPersonalisedSheetFilesKeySecret
+  return $ PersonalisedSheetFilesKeySet{ psfksSeed = Nothing, .. }
 
 mkPersonalisedFilesDirectory :: Maybe Word24 -> CryptoFileNameUser -> FilePath
 mkPersonalisedFilesDirectory  Nothing cID = unpack $ toPathPiece cID

src/Handler/Sheet/PersonalisedFiles/Meta.hs

@@ -27,16 +27,20 @@ data PrettifyState
   = PrettifyInitial
   | PrettifyFlowSequence PrettifyState
   | PrettifyBlockSequence PrettifyState
+  | PrettifySeed | PrettifySeedDone
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 
+  
 formatPersonalisedSheetFilesMeta
   :: MonadIO m
-  => PersonalisedSheetFilesDownloadAnonymous
+  => MsgRendererS UniWorX
+  -> PersonalisedSheetFilesDownloadAnonymous
   -> CourseParticipant
   -> CryptoFileNameUser
+  -> Maybe (UserIdent -> PersonalisedSheetFilesSeed)
   -> SqlPersistT m Lazy.ByteString
-formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do
+formatPersonalisedSheetFilesMeta (MsgRenderer mr) anonMode CourseParticipant{..} cID mkSeed = do
   User{..} <- getJust courseParticipantUser
   exams <- E.select . E.from $ \(exam `E.InnerJoin` examRegistration) -> E.distinctOnOrderBy [E.asc $ exam E.^. ExamName] $ do
     E.on $ exam E.^. ExamId E.==. examRegistration E.^. ExamRegistrationExam
@@ -50,6 +54,7 @@ formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do
           , YAML.Event.MappingStart Nothing YAML.untagged YAML.Event.Block
           ]
         , mapEvents (str' "user") (str $ toPathPiece cID)
+        , mapEvents (str' "seed") (maybe (YAML.Scalar () YAML.SNull) (str . toPathPiece . ($ userIdent)) mkSeed)
         , guardOnM (isn't _PersonalisedSheetFilesDownloadAnonymous anonMode) $ concat
           [ mapEvents (str' "display_name") (str userDisplayName)
           , mapEvents (str' "surname") (str userSurname)
@@ -113,6 +118,11 @@ formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do
                        in (before <> ann1 <> fromStrict (encodeUtf8 $ ann3 event'') <> fromStrict (encodeUtf8 $ ann2 ws) <> after, pos1')
 
           transduce :: PrettifyState -> YAML.Event.Event -> ((Text, Text -> Text, Text -> Text), PrettifyState)
+          transduce PrettifyInitial (YAML.Event.Scalar _ _ _ k)
+            | k == "seed", is _Just mkSeed = (("\n# " <> mr MsgSheetPersonalisedFilesMetaYAMLSeedComment <> "\n", id, id), PrettifySeed)
+            | k == "seed" = (("\n# " <> mr MsgSheetPersonalisedFilesMetaYAMLNoSeedComment <> "\n", id, id), PrettifySeed)
+          transduce PrettifySeed YAML.Event.Scalar{}
+            = ((mempty, id, beforeBreak "\n"), PrettifySeedDone)
           transduce cState (YAML.Event.SequenceStart _ _ YAML.Event.Flow) = ((mempty, id, bool " " mempty . null), PrettifyFlowSequence cState)
           transduce (PrettifyFlowSequence pState) YAML.Event.SequenceEnd = ((mempty, id, id), pState)
           transduce cState@(PrettifyFlowSequence _) _ = ((mempty, f, bool " " mempty . null), cState)
@@ -124,4 +134,11 @@ formatPersonalisedSheetFilesMeta anonMode CourseParticipant{..} cID = do
           transduce cState@(PrettifyBlockSequence _) _ = ((mempty, Text.replace "\n-" "\n  -", id), cState)
           transduce cState _ = ((mempty, id, id), cState)
           -- transduce cState _ = (("<", id, \ws -> "|" <> ws <> ">"), cState) -- TODO
+
+          beforeBreak :: Text -> Text -> Text
+          beforeBreak ins ws = before <> ins <> break' <> after
+            where (before', after) = Text.breakOnEnd "\n" ws
+                  before = Text.dropWhileEnd (== '\n') before'
+                  break' = Text.takeWhileEnd (== '\n') before'
+
   return prettyYAML

src/Handler/Sheet/PersonalisedFiles/Types.hs

@@ -1,9 +1,33 @@
 module Handler.Sheet.PersonalisedFiles.Types
   ( PersonalisedSheetFilesDownloadAnonymous(..)
   , _PersonalisedSheetFilesDownloadAnonymous, _PersonalisedSheetFilesDownloadSurnames, _PersonalisedSheetFilesDownloadMatriculations, _PersonalisedSheetFilesDownloadGroups
+  , PersonalisedSheetFilesSeed(..)
+  , mkPersonalisedSheetFilesSeed
+  , PersonalisedSheetFilesSeedKey
+  , derivePersonalisedSheetFilesSeedKey, newPersonalisedSheetFilesSeedKey
+  , PersonalisedSheetFilesKeySet(..)
   ) where
 
-import Import
+import Import.NoModel
+import Model.Types.Common (UserIdent)
+
+import Web.HttpApiData (ToHttpApiData, FromHttpApiData)
+import Data.ByteArray (ByteArrayAccess)
+import qualified Data.ByteArray as BA
+
+import Crypto.Hash.Algorithms (SHAKE256)
+import qualified Crypto.MAC.KMAC as Crypto
+import qualified Crypto.Random as Crypto
+import qualified Data.Binary as Binary
+
+import qualified Data.CaseInsensitive as CI
+
+import Data.CryptoID.ByteString (CryptoIDKey)
+
+import Data.Typeable (typeOf)
+  
+import Data.Binary.Put (putByteString)
+import Data.Binary.Get (getByteString)
 
 
 data PersonalisedSheetFilesDownloadAnonymous
@@ -14,6 +38,56 @@ data PersonalisedSheetFilesDownloadAnonymous
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
   deriving anyclass (Universe, Finite)
 nullaryPathPiece ''PersonalisedSheetFilesDownloadAnonymous $ camelToPathPiece' 4
-embedRenderMessage ''UniWorX ''PersonalisedSheetFilesDownloadAnonymous id
 
 makePrisms ''PersonalisedSheetFilesDownloadAnonymous
+
+
+newtype PersonalisedSheetFilesSeed = PersonalisedSheetFilesSeed (Digest (SHAKE256 144))
+  deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
+  deriving newtype ( PersistField
+                   , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
+                   , Hashable, NFData
+                   , ByteArrayAccess
+                   , Binary
+                   )
+
+newtype PersonalisedSheetFilesSeedKey = PersonalisedSheetFilesSeedKey { psfskKeyMaterial :: ByteString }
+  deriving (Typeable)
+  deriving newtype (ByteArrayAccess)
+  
+-- | Does not actually show any key material
+instance Show PersonalisedSheetFilesSeedKey where
+  show = show . typeOf
+
+instance Binary PersonalisedSheetFilesSeedKey where
+  put = putByteString . psfskKeyMaterial
+  get = PersonalisedSheetFilesSeedKey <$> getByteString 16
+  
+instance Eq PersonalisedSheetFilesSeedKey where
+  (==) = BA.constEq
+
+derivePersistFieldBinary ''PersonalisedSheetFilesSeedKey
+deriveJSONBinary ''PersonalisedSheetFilesSeedKey
+
+
+derivePersonalisedSheetFilesSeedKey :: ByteArrayAccess ba => PersonalisedSheetFilesSeedKey -> ba -> PersonalisedSheetFilesSeedKey
+derivePersonalisedSheetFilesSeedKey k = PersonalisedSheetFilesSeedKey . BA.convert . Crypto.kmac @(SHAKE256 128) (enc 'derivePersonalisedSheetFilesSeedKey) k
+  where
+    enc :: forall a. Binary a => a -> ByteString
+    enc = toStrict . Binary.encode
+
+newPersonalisedSheetFilesSeedKey :: Crypto.MonadRandom m => m PersonalisedSheetFilesSeedKey
+newPersonalisedSheetFilesSeedKey = PersonalisedSheetFilesSeedKey <$> Crypto.getRandomBytes 16
+  
+mkPersonalisedSheetFilesSeed :: PersonalisedSheetFilesSeedKey
+                             -> UserIdent
+                             -> PersonalisedSheetFilesSeed
+mkPersonalisedSheetFilesSeed k u = PersonalisedSheetFilesSeed . Crypto.kmacGetDigest $ Crypto.kmac (enc 'mkPersonalisedSheetFilesSeed) k (enc $ CI.foldedCase u)
+  where
+    enc :: forall a. Binary a => a -> ByteString
+    enc = toStrict . Binary.encode
+
+data PersonalisedSheetFilesKeySet = PersonalisedSheetFilesKeySet
+  { psfksCryptoID :: CryptoIDKey
+  , psfksSeed :: Maybe PersonalisedSheetFilesSeedKey 
+  } deriving (Show, Typeable)

src/Handler/Sheet/Show.hs

@@ -19,8 +19,11 @@ getSShowR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSShowR tid ssh csh shn = do
   now <- liftIO getCurrentTime
   muid <- maybeAuthId
-  Entity sid sheet <- runDB $ fetchSheet tid ssh csh shn
+  sheetEnt@(Entity sid sheet) <- runDB $ fetchSheet tid ssh csh shn
+
   seeAllModificationTimestamps <- hasReadAccessTo $ CSheetR tid ssh csh shn SIsCorrR -- ordinary users should not see modification dates older than visibility
+  -- mayEdit <- hasWriteAccessTo $ CSheetR tid ssh csh shn SEditR
+  -- maySubmit <- hasWriteAccessTo $ CSheetR tid ssh csh shn SubmissionNewR
 
   let sftVisible :: IsDBTable m a => SheetFileType -> DBCell m a
       sftVisible sft | Just dts <- sheetFileTypeDates sheet sft
@@ -151,6 +154,7 @@ getSShowR tid ssh csh shn = do
     return $ notification NotificationBroad =<< messageI Warning MsgSheetSubmissionModeNoneWithoutNotGraded
 
   sTypeDesc <- runDB $ sheetTypeDescription (sheetCourse sheet) (sheetType sheet)
+  authorshipStatementRequired <- fmap (is _Just) . runDB $ getSheetAuthorshipStatement sheetEnt
 
   defaultLayout $ do
     setTitleI $ prependCourseTitle tid ssh csh $ SomeMessage shn

src/Handler/Submission.hs

@@ -11,6 +11,7 @@ module Handler.Submission
   , module Handler.Submission.Create
   , module Handler.Submission.Grade
   , module Handler.Submission.Upload
+  , module Handler.Submission.AuthorshipStatements
   ) where
 
 import Handler.Submission.New
@@ -24,6 +25,7 @@ import Handler.Submission.Correction
 import Handler.Submission.Create
 import Handler.Submission.Grade
 import Handler.Submission.Upload
+import Handler.Submission.AuthorshipStatements
 
 import Handler.Utils
 

src/Handler/Submission/AuthorshipStatements.hs

@@ -0,0 +1,142 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
+module Handler.Submission.AuthorshipStatements
+  ( getSubAuthorshipStatementsR
+  ) where
+
+import Import
+import Handler.Utils
+import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
+
+
+type AuthorshipStatementsExpr = E.SqlExpr (Entity AuthorshipStatementSubmission)
+                  `E.InnerJoin` E.SqlExpr (Entity User)
+                  `E.InnerJoin` E.SqlExpr (Entity AuthorshipStatementDefinition)
+
+queryAuthorshipStatement :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity AuthorshipStatementSubmission))
+queryAuthorshipStatement = to $(E.sqlIJproj 3 1)
+
+queryUser :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity User))
+queryUser = to $(E.sqlIJproj 3 2)
+  
+queryDefinition :: Getter AuthorshipStatementsExpr (E.SqlExpr (Entity AuthorshipStatementDefinition))
+queryDefinition = to $(E.sqlIJproj 3 3)
+
+
+type AuthorshipStatementsData = DBRow ( Entity AuthorshipStatementSubmission
+                                      , Entity User
+                                      , Entity AuthorshipStatementDefinition
+                                      )
+
+resultAuthorshipStatement :: Lens' AuthorshipStatementsData (Entity AuthorshipStatementSubmission)
+resultAuthorshipStatement = _dbrOutput . _1
+
+resultUser :: Lens' AuthorshipStatementsData (Entity User)
+resultUser = _dbrOutput . _2
+  
+resultDefinition :: Lens' AuthorshipStatementsData (Entity AuthorshipStatementDefinition)
+resultDefinition = _dbrOutput . _3
+  
+
+getSubAuthorshipStatementsR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
+getSubAuthorshipStatementsR tid ssh csh shn cID = do
+  authorshipStatementTable <- runDB $ do
+    subId <- decrypt cID
+    Submission{..} <- get404 subId
+    isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True
+    mASDefinition <- getSheetAuthorshipStatement =<< getEntity404 submissionSheet
+    
+    let dbtIdent :: Text
+        dbtIdent = "authorship-statements"
+
+        dbtSQLQuery = runReaderT $ do
+          authorshipStatement <- view queryAuthorshipStatement
+          user <- view queryUser
+          definition <- view queryDefinition
+
+          lift $ do
+            E.on $ definition E.^. AuthorshipStatementDefinitionId E.==. authorshipStatement E.^. AuthorshipStatementSubmissionStatement
+            E.on $ user E.^. UserId E.==. authorshipStatement E.^. AuthorshipStatementSubmissionUser
+
+            E.where_ $ authorshipStatement E.^. AuthorshipStatementSubmissionSubmission E.==. E.val subId
+
+          return (authorshipStatement, user, definition)
+        dbtRowKey = views queryAuthorshipStatement (E.^. AuthorshipStatementSubmissionId)
+
+        dbtProj = dbtProjId
+
+        dbtColonnade :: Colonnade Sortable AuthorshipStatementsData (DBCell (HandlerFor UniWorX) ())
+        dbtColonnade = mconcat $ catMaybes
+          [ pure . sortable (Just "authorship-statement-time") (i18nCell MsgSubmissionColumnAuthorshipStatementTime) $ views (resultAuthorshipStatement . _entityVal . _authorshipStatementSubmissionTime) dateTimeCell
+          , pure $ colUserDisplayName (resultUser . _entityVal . $(multifocusG 2) _userDisplayName _userSurname)
+          , guardOn isLecturer $ colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
+          , pure $ lmap (view $ resultUser . _entityVal) colUserEmail
+          , pure . sortable Nothing (i18nCell MsgSubmissionColumnAuthorshipStatementWording) $ views resultDefinition definitionCell
+          ]
+          where
+            definitionCell (Entity asdId asd)
+                = withColor . (cellAttrs %~ addAttrsClass "table__td--center") . modalCell $ authorshipStatementWidget asd
+              where
+                withColor c
+                  | Just (Entity currASDId _) <- mASDefinition
+                  = c
+                  & cellAttrs %~ addAttrsClass "heated"
+                  & cellAttrs <>~ pure ("style", [st|--hotness: #{tshow (boolHeat (asdId /= currASDId))}|])
+                  | otherwise
+                  = c
+
+        dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
+
+        dbtSorting = mconcat
+          [ singletonMap "authorship-statement-time" . SortColumn $ views queryAuthorshipStatement (E.^. AuthorshipStatementSubmissionTime)
+          , sortUserName' (queryUser . $(multifocusG 2) (to (E.^. UserDisplayName)) (to (E.^. UserSurname)))
+          , sortUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
+          , uncurry singletonMap $ sortUserEmail (view queryUser)
+          ]
+        dbtFilter = mconcat
+          [ fltrUserName' (queryUser . to (E.^. UserDisplayName))
+          , fltrUserMatriculation (queryUser . to (E.^. UserMatrikelnummer))
+          , uncurry singletonMap $ fltrUserEmail (view queryUser)
+          , singletonMap "authorship-statement-current" . FilterColumn $ \(view queryAuthorshipStatement -> subStmt) (Last isCurrent)
+              -> let isCurrent'
+                       | Just (Entity asdId _) <- mASDefinition
+                       = subStmt E.^. AuthorshipStatementSubmissionStatement E.==. E.val asdId
+                       | otherwise
+                       = E.false
+                  in maybe E.true ((E.==. isCurrent') . E.val) isCurrent
+          ]
+
+        dbtFilterUI = mconcat $ catMaybes
+          [ pure fltrUserNameUI'
+          , guardOn isLecturer fltrUserMatriculationUI
+          , pure fltrUserEmailUI
+          , pure . flip (prismAForm $ singletonFilter "authorship-statement-current" . maybePrism _PathPiece) $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgSubmissionFilterAuthorshipStatementCurrent)
+          ]
+
+        dbtParams = def
+
+        dbtCsvEncode = noCsvEncode
+        dbtCsvDecode = Nothing
+        dbtExtraReps = []
+
+        asPSValidator = def
+          & defaultSorting [SortDescBy "authorship-statement-time"]
+          & restrictFilter lecturerFilter & restrictSorting lecturerSorting
+          where
+            lecturerFilter fk _
+              | isLecturer = True
+              | otherwise  = fk /= "user-matriculation"
+            lecturerSorting sk _
+              | isLecturer = True
+              | otherwise  = sk /= "user-matriculation"
+     in dbTableWidget' asPSValidator DBTable{..}
+
+  let (heading, title) = ( MsgSubmissionAuthorshipStatementsHeading tid ssh csh shn cID
+                         , MsgSubmissionAuthorshipStatementsTitle tid ssh csh shn cID
+                         )
+
+  siteLayoutMsg heading $ do
+    setTitleI title
+
+    authorshipStatementTable

src/Handler/Submission/Grade.hs

@@ -49,13 +49,13 @@ postCorrectionsGradeR = do
         ]
       courseOptions = runDB $ do
         courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . courseShorthand . entityVal) courses
       termOptions = runDB $ do
         courses <- selectList [] [Asc CourseTerm]      >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (termToText . unTermKey . courseTerm . entityVal) courses
       schoolOptions = runDB $ do
         courses <- selectList [] [Asc CourseSchool]    >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
       psValidator = def
         & restrictAnonymous
         & restrictCorrector

src/Handler/Submission/Helper.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
-
 module Handler.Submission.Helper
   ( submissionHelper
   ) where
@@ -12,11 +10,12 @@ import Handler.Utils
 import Handler.Utils.Submission
 import Handler.Utils.Invitations
 
+import Handler.Submission.Helper.ArchiveTable
+
 import Data.Maybe (fromJust)
 
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
-import qualified Database.Esqueleto.Internal.Internal as E (unsafeSqlFunction)
 
 import qualified Data.Set as Set
 import Data.Map ((!), (!?))
@@ -32,15 +31,52 @@ import Handler.Submission.SubmissionUserInvite
 import qualified Data.Conduit.Combinators as C
 
 
-makeSubmissionForm :: CourseId -> SheetId -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId) -> Form (Maybe FileUploads, Set (Either UserEmail UserId))
+data AuthorshipStatementSubmissionState
-makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderAForm FormStandard $ (,)
+  = ASExists
-  <$> uploadForm
+  | ASOldStatement
-  <*> wFormToAForm submittorsForm'
+  | ASMissing
+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
+  deriving anyclass (Universe, Finite)
+
+nullaryPathPiece ''AuthorshipStatementSubmissionState $ camelToPathPiece' 1
+
+embedRenderMessage ''UniWorX ''AuthorshipStatementSubmissionState $ concat . ("SubmissionAuthorshipStatementState" :) . drop 1 . splitCamel
+
+
+makeSubmissionForm :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m)
+                   => CourseId -> SheetId -> Maybe (Entity AuthorshipStatementDefinition) -> Maybe SubmissionId -> UploadMode -> SheetGroup -> Maybe FileUploads -> Bool -> Set (Either UserEmail UserId)
+                   -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult (Maybe FileUploads, Set (Either UserEmail UserId), Maybe AuthorshipStatementDefinitionId), Widget))
+makeSubmissionForm cid shid mASDefinition msmid uploadMode grouping mPrev isLecturer prefillUsers = identifyForm FIDsubmission . renderWForm FormStandard $ do
+  uploadRes <- aFormToWForm uploadForm
+  submittorsRes <- submittorsForm'
+  lecturerIsSubmittor <- case submittorsRes of
+    FormSuccess subs -> maybe False ((`Set.member` subs) . Right) <$> maybeAuthId
+    _other -> return False
+  authorshipStatementRes <- authorshipStatementForm lecturerIsSubmittor
+  return $ (,,) <$> uploadRes <*> submittorsRes <*> authorshipStatementRes
   where
-    uploadForm
+    -- TODO(AuthorshipStatements): for lecturer: optionally only invite (co-)submittors instead of adding directly; so they will be forced to make authorship statements
-      | is _NoUpload uploadMode = pure Nothing
+    -- also take care that accepting the invite (optionally) remains possible even after the submission deadline (for creating submissions for course users as a lecturer)
-      | is _Nothing msmid = uploadForm'
+    
-      | otherwise = join <$> optionalActionNegatedA uploadForm' (fslI MsgSubmissionFilesUnchanged & setTooltip MsgSubmissionFilesUnchangedTip) (Just False)
+    authorshipStatementForm :: Bool -> WForm (ReaderT SqlBackend m) (FormResult (Maybe AuthorshipStatementDefinitionId))
+    authorshipStatementForm lecturerIsSubmittor = maybeT (return $ FormSuccess Nothing) $ do
+      asd <- hoistMaybe mASDefinition
+      let authorshipStatementForm' = apopt (acceptAuthorshipStatementField asd) (fslI MsgSubmissionAuthorshipStatement & setTooltip MsgSubmissionAuthorshipStatementTip) Nothing
+      authorshipStatementRes <- lift . hoist (hoist liftHandler) $ if
+        | isLecturer
+          -> optionalActionW authorshipStatementForm' (fslI MsgSubmissionLecturerAuthorshipStatement & setTooltip MsgSubmissionLecturerAuthorshipStatementTip) (Just False)
+        | otherwise
+          -> fmap Just <$> aFormToWForm authorshipStatementForm'
+      if
+        | FormSuccess Nothing <- authorshipStatementRes
+        , lecturerIsSubmittor -> formFailure [MsgSubmissionLecturerAuthorshipStatementRequiredBecauseSubmittor]
+        | otherwise -> return authorshipStatementRes
+
+    uploadForm :: AForm (ReaderT SqlBackend m) (Maybe FileUploads)
+    uploadForm = hoistAForm liftHandler $ if
+      | is _NoUpload uploadMode -> pure Nothing
+      | is _Nothing msmid -> uploadForm'
+      | otherwise -> join <$> optionalActionNegatedA uploadForm' (fslI MsgSubmissionFilesUnchanged & setTooltip MsgSubmissionFilesUnchangedTip) (Just False)
 
     uploadForm' = fileUploadForm (not isLecturer) (fslI . bool MsgSubmissionFile MsgSubmissionArchive) uploadMode mPrev
     
@@ -98,9 +134,11 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs
       E.orderBy [E.asc $ user E.^. UserEmail]
       return user
 
-    addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> Field m (Set (Either UserEmail UserId))
+    addField :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => UserId -> Field m' (Set (Either UserEmail UserId))
     addField uid = multiUserInvitationField . MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationPrevCoSubmittors) $ previousCoSubmittors uid
+    addFieldLecturer, addFieldAuthorshipStatements :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Field m' (Set (Either UserEmail UserId))
     addFieldLecturer = multiUserInvitationField $ MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationCourseParticipants) courseUsers
+    addFieldAuthorshipStatements = multiUserInvitationField MUIAlwaysInvite
 
     addFieldSettings :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> FieldSettings UniWorX
     addFieldSettings mr = fslpI MsgSubmissionMembers $ mr MsgLdapIdentificationOrEmail
@@ -119,6 +157,7 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs
     miButtonAction' :: forall p. PathPiece p => Maybe (Route UniWorX) -> p -> Maybe (SomeRoute UniWorX)
     miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag)
 
+    submittorsForm' :: WForm (ReaderT SqlBackend m) (FormResult (Set (Either UserEmail UserId)))
     submittorsForm' = maybeT submittorsForm $ do
       restr <- MaybeT (liftHandler $ maybeCurrentBearerRestrictions @Value) >>= hoistMaybe . preview (_Object . ix "submittors" . _Array)
       let _Submittor = prism (either toJSON toJSON) $ \x -> first (const x) $ JSON.parseEither (\x' -> fmap Right (parseJSON x') <|> fmap Left (parseJSON x')) x
@@ -126,10 +165,11 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs
       fmap Set.fromList <$> forMOf (traverse . traverse . _Right) submittors decrypt
 
 
+    submittorsForm :: WForm (ReaderT SqlBackend m) (FormResult (Set (Either UserEmail UserId)))
     submittorsForm
       | isLecturer = do -- Form is being used by lecturer; allow Everything™
         let
-          miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
+          miAdd :: (Text -> Text) -> FieldView UniWorX -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]), Widget))
           miAdd nudge btn csrf = do
             MsgRenderer mr <- getMsgRenderer
             (addRes, addView) <- mpreq addFieldLecturer (addFieldSettings mr & addName (nudge "emails")) Nothing
@@ -150,16 +190,28 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs
       | otherwise = do
         uid <- liftHandler requireAuthId
         mRoute <- getCurrentRoute
+        let doAuthorshipStatements = is _Just mASDefinition
+
+        prefillUsers' <- lift . lift . fmap catMaybes . for (Set.toList prefillUsers) $ \case
+          Right uid' | doAuthorshipStatements
+                     , uid /= uid'
+                       -> fmap (Left . userEmail) <$> get uid'
+          other -> return $ pure other
 
         let
           miAdd :: ListPosition
                 -> Natural
+                -> ListLength
                 -> (Text -> Text)
                 -> FieldView UniWorX
-                -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
+                -> Maybe (Markup -> MForm (ReaderT SqlBackend m) (FormResult (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))), Widget))
-          miAdd _ _ nudge btn = Just $ \csrf -> do
+          miAdd dim pos liveliness nudge btn = guardOn (miAllowAdd dim pos liveliness) $ \csrf -> do
             MsgRenderer mr <- getMsgRenderer
-            (addRes, addView) <- mpreq (addField uid) (addFieldSettings mr & addName (nudge "emails")) Nothing
+            (addRes, addView) <- if
+              | doAuthorshipStatements
+                -> mpreq addFieldAuthorshipStatements (addFieldSettings mr & addName (nudge "emails") & setTooltip MsgSubmissionCoSubmittorsInviteRequiredBecauseAuthorshipStatements) Nothing
+              | otherwise
+                -> mpreq (addField uid) (addFieldSettings mr & addName (nudge "emails")) Nothing
             let addRes' = addRes <&> \newData oldData -> if
                   | existing <- newData `Set.intersection` setOf folded oldData
                   , not $ Set.null existing
@@ -172,12 +224,12 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs
                  -> Either UserEmail UserId
                  -> Maybe ()
                  -> (Text -> Text)
-                 -> Form ()
+                 -> (Markup -> MForm (ReaderT SqlBackend m) (FormResult (), Widget))
           miCell _ dat _ _ csrf = return (FormSuccess (), miCell' csrf dat)
 
           miDelete :: Map ListPosition (Either UserEmail UserId)
                    -> ListPosition
-                   -> MaybeT (MForm Handler) (Map ListPosition ListPosition)
+                   -> MaybeT (MForm (ReaderT SqlBackend m)) (Map ListPosition ListPosition)
           miDelete dat delPos = do
             guard mayEdit
             guard $ Map.size dat > 1
@@ -214,7 +266,7 @@ makeSubmissionForm cid shid msmid uploadMode grouping mPrev isLecturer prefillUs
             where resultUsers = setOf (folded . _1) valMap
         -- when (maxSize > Just 1) $
         --   wformMessage =<< messageI Info MsgCosubmittorTip
-        fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers)
+        fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ prefillUsers')
 
 submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Maybe CryptoFileNameSubmission -> Handler Html
 submissionHelper tid ssh csh shn mcid = do
@@ -225,6 +277,7 @@ submissionHelper tid ssh csh shn mcid = do
   let
     getSheetInfo = do
       csheet@(Entity shid Sheet{..})  <- fetchSheet tid ssh csh shn
+      mASDefinition <- getSheetAuthorshipStatement csheet
       maySubmit  <- (== Authorized) <$> evalAccessDB actionUrl True
       isLecturer <- (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn SSubsR) True
 
@@ -257,6 +310,7 @@ submissionHelper tid ssh csh shn mcid = do
                  , isLecturer
                  , not isLecturer
                  , Nothing, Nothing
+                 , mASDefinition
                  )
         (Nothing, RegisteredGroups) -> do
           buddies <- E.select . E.from $ \(submissionGroup `E.InnerJoin` user) -> do
@@ -286,8 +340,9 @@ submissionHelper tid ssh csh shn mcid = do
                  , isLecturer
                  , not isLecturer
                  , Nothing, Nothing
+                 , mASDefinition
                  )
-        (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer, Nothing, Nothing)
+        (Nothing, _) -> return (csheet, Set.empty, [], maySubmit, isLecturer, not isLecturer, Nothing, Nothing, mASDefinition)
         (Just smid, _) -> do
           void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)
 
@@ -324,280 +379,275 @@ submissionHelper tid ssh csh shn mcid = do
 
           corrector <- join <$> traverse getEntity submissionRatingBy
 
-          return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner,Just sub,corrector)
+          return (csheet,buddies,lastEdits,maySubmit,isLecturer,isOwner,Just sub,corrector,mASDefinition)
 
   -- @submissionModeUser == Nothing@ below iff we are currently serving a user with elevated rights (lecturer, admin, ...)
   -- Therefore we do not restrict upload behaviour in any way in that case
-  ((res,formWidget'), formEnctype) <- do
+  ((formWidget', formEnctype), mAct) <- runDBJobs . setSerializable $ do
-    (Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, _, _) <- runDB getSheetInfo
+    (Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- hoist lift getSheetInfo
     let mPrevUploads = msmid <&> \smid -> runDBSource $ selectSource [SubmissionFileSubmission ==. smid, SubmissionFileIsUpdate ==. False] [Asc SubmissionFileTitle] .| C.map (view $ _FileReference . _1)
-    runFormPost . makeSubmissionForm sheetCourse shid msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
+    ((res, formWidget'), formEnctype) <- hoist lift . runFormPost . makeSubmissionForm sheetCourse shid mASDefinition msmid (fromMaybe (UploadAny True Nothing True) . submissionModeUser $ sheetSubmissionMode) sheetGrouping mPrevUploads isLecturer $ bool id (maybe id (Set.insert . Right) muid) isOwner buddies
+
+    -- Calling `msgSubmissionErrors` within a `runDB` is okay as long as we handle `transactionUndo` ourselves iff it returns nothing
+    mAct' <- msgSubmissionErrors $ do
+      submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
+        E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
+        E.where_ $ E.just (submissionUser E.^. SubmissionUserUser) E.==. E.val muid
+             E.&&. submission     E.^. SubmissionSheet    E.==. E.val shid
+        return $ submission E.^. SubmissionId
+      case (msmid, submissions) of
+        (Nothing, E.Value smid : _) -> do
+          cID <- encrypt smid
+          addMessageI Info MsgSubmissionAlreadyExists
+          redirect $ CSubmissionR tid ssh csh shn cID SubShowR
+        _other -> return ()
+
+      when (    is _Nothing muid
+             && is _Nothing msubmission
+             && not isLecturer
+           )
+        notAuthenticated
+
+      -- Determine old submission users
+      subUsersOld <- if
+        | Just smid <- msmid -> Set.union
+            <$> (setOf (folded . _entityVal . _submissionUserUser . to Right) <$> selectList [SubmissionUserSubmission ==. smid] [])
+            <*> (sourceInvitationsF smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email))
+        | otherwise -> return Set.empty
+
+      res' <- case res of
+        FormMissing              -> return   FormMissing
+        (FormFailure failmsgs)   -> return $ FormFailure failmsgs
+        (FormSuccess res'@(_, groupMembers, _))
+          | groupMembers == subUsersOld -> return $ FormSuccess res'
+          | isLecturer -> return $ FormSuccess res'
+          | Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members
+            let (gEMails, gIds) = partitionEithers $ Set.toList groupMembers
+                prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map UserEmail (Maybe (UserId, Bool, Bool))
+                prep ps = Map.fromList $ map (, Nothing) gEMails ++ [(m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
+            participants <- fmap prep . E.select . E.from $ \user -> do
+              E.where_ $ (user E.^. UserId) `E.in_` E.valList gIds
+              let
+                isParticipant = E.exists . E.from $ \courseParticipant -> do
+                  E.where_ $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
+                       E.&&. courseParticipant E.^. CourseParticipantCourse E.==. E.val sheetCourse
+                       E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
+                hasSubmitted = E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
+                  E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+                  E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
+                       E.&&. submission E.^. SubmissionSheet E.==. E.val shid
+                  case msmid of -- Multiple `E.where_`-Statements are merged with `&&` in esqueleto 2.5.3
+                    Nothing   -> return ()
+                    Just smid -> E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
+              return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted))
+
+            $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
+
+            mr <- getMessageRender
+            let
+              failmsgs = (concat :: [[Text]] -> [Text])
+                [ flip Map.foldMapWithKey participants $ \email -> \case
+                    -- Nothing            -> pure . mr $ MsgEMailUnknown email
+                    (Just (_,False,_)) -> pure . mr $ MsgNotAParticipant email tid csh
+                    (Just (_,_, True)) -> pure . mr $ MsgSubmissionAlreadyExistsFor email
+                    _other             -> mempty
+                , case fromIntegral (Map.size participants) `compare` maxParticipants of
+                    GT | not isLecturer -> pure $ mr MsgTooManyParticipants
+                    _ -> mempty
+                ]
+            return $ if null failmsgs
+              then FormSuccess res'
+              else FormFailure failmsgs
+          | otherwise -> return $ FormSuccess res'
+
+
+      formResultMaybe res' $ \(mFiles, adhocMembers, mASDId) -> do
+        now <- liftIO getCurrentTime
+
+        smid <- case (mFiles, msmid) of
+          (Nothing, Just smid)   -- no new files, existing submission partners updated
+            -> return smid
+          (Just files, _) -> -- new files
+            runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkSubmission muid (maybe (Left shid) Right msmid) False
+          (Nothing, Nothing) -- new submission, no file upload requested
+            -> do
+              sid <- insert Submission
+                { submissionSheet = shid
+                , submissionRatingPoints   = Nothing
+                , submissionRatingComment  = Nothing
+                , submissionRatingBy       = Nothing
+                , submissionRatingAssigned = Nothing
+                , submissionRatingTime     = Nothing
+                }
+              audit $ TransactionSubmissionEdit sid shid
+
+              insert_ $ SubmissionEdit muid now sid
+
+              return sid
+
+        -- Determine new submission users
+        subUsers <- if
+          | isLecturer -> return adhocMembers
+          | RegisteredGroups <- sheetGrouping -> do
+              -- Determine members of pre-registered group
+              groupUids <- fmap (setFromList . map (Right . E.unValue)) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
+                E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup
+                E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+                E.where_ $ E.just (submissionGroupUser E.^. SubmissionGroupUserUser) E.==. E.val muid
+                    E.&&.  submissionGroup     E.^. SubmissionGroupCourse   E.==. E.val sheetCourse
+
+                E.where_ . E.not_ . E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
+                  E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+                  E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
+                       E.&&. submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser' E.^. SubmissionGroupUserUser
+                  E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
+
+                return $ submissionGroupUser' E.^. SubmissionGroupUserUser
+              -- SubmissionUser for all group members (pre-registered & ad-hoc)
+              return $ maybe id (Set.insert . Right) muid groupUids
+          | otherwise -> return adhocMembers
+
+        -- Since invitations carry no data we only need to consider changes to
+        -- the set of users/invited emails
+        -- Otherwise we would have to update old invitations (via
+        -- `sinkInvitationsF`) because their associated @DBData@ might have
+        -- changed
+
+        forM_ (subUsers `setSymmDiff` subUsersOld) $ \change -> if
+          -- change is a new user being added to the submission users => send invitation / insert
+          | change `Set.member` subUsers -> case change of
+            Left subEmail -> do
+              -- user does not exist yet => send invitation
+              sinkInvitationsF submissionUserInvitationConfig [(subEmail, smid, (InvDBDataSubmissionUser, InvTokenDataSubmissionUser))]
+              return ()
+            Right subUid -> do
+              -- user exists and has an id => insert as SubmissionUser and audit
+              insert_ $ SubmissionUser subUid smid
+              audit $ TransactionSubmissionUserEdit smid subUid
+              unless (Just subUid == muid) $
+                queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated subUid smid
+          -- change is an old user that is not a submission user anymore => delete invitation / delete
+          | otherwise -> case change of
+            Left subEmail -> deleteInvitation @SubmissionUser smid subEmail
+            Right subUid  -> do
+              deleteBy $ UniqueSubmissionUser subUid smid
+              audit $ TransactionSubmissionUserDelete smid subUid
+              unless (Just subUid == muid) $
+                queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid
+
+        hasAuthorshipStatement <- maybeT (return True) $ do
+          uid <- hoistMaybe muid
+          asDId <- hoistMaybe mASDId
+          lift $ exists [AuthorshipStatementSubmissionStatement ==. asDId, AuthorshipStatementSubmissionSubmission ==. smid, AuthorshipStatementSubmissionUser ==. uid]
+  
+        forM_ mASDId $ \asdId -> do
+          uid <- maybe notAuthenticated return muid
+          insert_ $ AuthorshipStatementSubmission asdId smid uid now
+
+
+        if | is _Nothing msmid          -> addMessageI Success MsgSubmissionCreated
+           | is _Just mFiles            -> addMessageI Success MsgSubmissionUpdated
+           | subUsers == subUsersOld
+           , not hasAuthorshipStatement -> addMessageI Success MsgSubmissionUpdatedAuthorshipStatement
+           | subUsers == subUsersOld    -> addMessageI Info    MsgSubmissionUnchanged
+           | otherwise                  -> addMessageI Success MsgSubmissionUsersUpdated
+
+        cID <- encrypt smid
+        let showRoute = CSubmissionR tid ssh csh shn cID SubShowR
+        mayShow <- hoist lift $ hasReadAccessTo showRoute
+
+        return . Just $ if
+          | mayShow   -> redirect showRoute
+          | otherwise -> redirect $ CSheetR tid ssh csh shn SShowR
+
+    case mAct' of
+      Nothing -> ((formWidget', formEnctype), Nothing) <$ E.transactionUndo -- manual rollback because we are calling `msgSubmissionErrors` within a `runDB`
+      Just mAct -> return ((formWidget', formEnctype), mAct)
+
+  sequence_ mAct
   let formWidget = wrapForm' BtnHandIn formWidget' def
         { formAction = Just $ SomeRoute actionUrl
         , formEncoding = formEnctype
         }
 
-  mCID <- fmap join . msgSubmissionErrors . runDBJobs . setSerializable $ do
+  ((Entity _ Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector, _), (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, (subUsers, subUsersVisible), isLecturer, isOwner, doAuthorshipStatements) <- runDB $ do
-    (Entity shid Sheet{..}, _, _, _, isLecturer, _, msubmission, _) <- hoist lift getSheetInfo
+    sheetInfo@(Entity shid Sheet{..}, buddies, _, _, isLecturer, isOwner, msubmission, _, mASDefinition) <- getSheetInfo
 
-    submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do
+    (showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> do
-      E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission)
+      showCorrection <- hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
-      E.where_ $ E.just (submissionUser E.^. SubmissionUserUser) E.==. E.val muid
+      correctionInvisible <- correctionInvisibleWidget tid ssh csh shn cid subEnt
-           E.&&. submission     E.^. SubmissionSheet    E.==. E.val shid
-      return $ submission E.^. SubmissionId
-    case (msmid, submissions) of
-      (Nothing, E.Value smid : _) -> do
-        cID <- encrypt smid
-        addMessageI Info MsgSubmissionAlreadyExists
-        redirect $ CSubmissionR tid ssh csh shn cID SubShowR
-      _other -> return ()
 
-    when (    is _Nothing muid
+      return (showCorrection, correctionInvisible)
-           && is _Nothing msubmission
-           && not isLecturer
-         )
-      notAuthenticated
 
-    -- Determine old submission users
+    -- Maybe construct a table to display uploaded archive files
-    subUsersOld <- if
+    mFileTable' <- for msmid $ mkSubmissionArchiveTable tid ssh csh shn showCorrection
-      | Just smid <- msmid -> Set.union
+    let filesCorrected = maybe False (view _1) mFileTable'
-          <$> (setOf (folded . _entityVal . _submissionUserUser . to Right) <$> selectList [SubmissionUserSubmission ==. smid] [])
+        mFileTable = view _2 <$> mFileTable'
-          <*> (sourceInvitationsF smid <&> Set.fromList . map (\(email, InvDBDataSubmissionUser) -> Left email))
-      | otherwise -> return Set.empty
 
-    res' <- case res of
+    sheetTypeDesc <- sheetTypeDescription sheetCourse sheetType
-      FormMissing              -> return   FormMissing
-      (FormFailure failmsgs)   -> return $ FormFailure failmsgs
-      (FormSuccess res'@(_, groupMembers))
-        | groupMembers == subUsersOld -> return $ FormSuccess res'
-        | isLecturer -> return $ FormSuccess res'
-        | Arbitrary{..} <- sheetGrouping -> do -- Validate AdHoc Group Members
-          let (gEMails, gIds) = partitionEithers $ Set.toList groupMembers
-              prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map UserEmail (Maybe (UserId, Bool, Bool))
-              prep ps = Map.fromList $ map (, Nothing) gEMails ++ [(m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
-          participants <- fmap prep . E.select . E.from $ \user -> do
-            E.where_ $ (user E.^. UserId) `E.in_` E.valList gIds
-            let
-              isParticipant = E.exists . E.from $ \courseParticipant -> do
-                E.where_ $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser
-                     E.&&. courseParticipant E.^. CourseParticipantCourse E.==. E.val sheetCourse
-                     E.&&. courseParticipant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
-              hasSubmitted = E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
-                E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-                E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
-                     E.&&. submission E.^. SubmissionSheet E.==. E.val shid
-                case msmid of -- Multiple `E.where_`-Statements are merged with `&&` in esqueleto 2.5.3
-                  Nothing   -> return ()
-                  Just smid -> E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
-            return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted))
 
-          $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants
+    multipleSubmissionWarnWidget <- runMaybeT $ do
-
+      subId <- hoistMaybe msmid
-          mr <- getMessageRender
+      cID <- hoistMaybe mcid
-          let
+      guardM . lift $ orM
-            failmsgs = (concat :: [[Text]] -> [Text])
+        [ hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubDelR
-              [ flip Map.foldMapWithKey participants $ \email -> \case
+        , hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubShowR
-                  -- Nothing            -> pure . mr $ MsgEMailUnknown email
+        , hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
-                  (Just (_,False,_)) -> pure . mr $ MsgNotAParticipant email tid csh
+        , hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
-                  (Just (_,_, True)) -> pure . mr $ MsgSubmissionAlreadyExistsFor email
-                  _other             -> mempty
-              , case fromIntegral (Map.size participants) `compare` maxParticipants of
-                  GT | not isLecturer -> pure $ mr MsgTooManyParticipants
-                  _ -> mempty
-              ]
-          return $ if null failmsgs
-            then FormSuccess res'
-            else FormFailure failmsgs
-        | otherwise -> return $ FormSuccess res'
-
-
-    formResultMaybe res' $ \(mFiles, adhocMembers) -> do
-      smid <- case (mFiles, msmid) of
-        (Nothing, Just smid)   -- no new files, existing submission partners updated
-          -> return smid
-        (Just files, _) -> -- new files
-          runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkSubmission muid (maybe (Left shid) Right msmid) False
-        (Nothing, Nothing) -- new submission, no file upload requested
-          -> do
-            sid <- insert Submission
-              { submissionSheet = shid
-              , submissionRatingPoints   = Nothing
-              , submissionRatingComment  = Nothing
-              , submissionRatingBy       = Nothing
-              , submissionRatingAssigned = Nothing
-              , submissionRatingTime     = Nothing
-              }
-            audit $ TransactionSubmissionEdit sid shid
-
-            now <- liftIO getCurrentTime
-            insert_ $ SubmissionEdit muid now sid
-
-            return sid
-
-      -- Determine new submission users
-      subUsers <- if
-        | isLecturer -> return adhocMembers
-        | RegisteredGroups <- sheetGrouping -> do
-            -- Determine members of pre-registered group
-            groupUids <- fmap (setFromList . map (Right . E.unValue)) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do
-              E.on $ submissionGroup E.^. SubmissionGroupId  E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup
-              E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
-              E.where_ $ E.just (submissionGroupUser E.^. SubmissionGroupUserUser) E.==. E.val muid
-                  E.&&.  submissionGroup     E.^. SubmissionGroupCourse   E.==. E.val sheetCourse
-
-              E.where_ . E.not_ . E.exists . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
-                E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-                E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
-                     E.&&. submissionUser E.^. SubmissionUserUser E.==. submissionGroupUser' E.^. SubmissionGroupUserUser
-                E.where_ $ submission E.^. SubmissionId E.!=. E.val smid
-
-              return $ submissionGroupUser' E.^. SubmissionGroupUserUser
-            -- SubmissionUser for all group members (pre-registered & ad-hoc)
-            return $ maybe id (Set.insert . Right) muid groupUids
-        | otherwise -> return adhocMembers
-
-      -- Since invitations carry no data we only need to consider changes to
-      -- the set of users/invited emails
-      -- Otherwise we would have to update old invitations (via
-      -- `sinkInvitationsF`) because their associated @DBData@ might have
-      -- changed
-
-      forM_ (subUsers `setSymmDiff` subUsersOld) $ \change -> if
-        -- change is a new user being added to the submission users => send invitation / insert
-        | change `Set.member` subUsers -> case change of
-          Left subEmail -> do
-            -- user does not exist yet => send invitation
-            sinkInvitationsF submissionUserInvitationConfig [(subEmail, smid, (InvDBDataSubmissionUser, InvTokenDataSubmissionUser))]
-            return ()
-          Right subUid -> do
-            -- user exists and has an id => insert as SubmissionUser and audit
-            insert_ $ SubmissionUser subUid smid
-            audit $ TransactionSubmissionUserEdit smid subUid
-            unless (Just subUid == muid) $
-              queueDBJob . JobQueueNotification $ NotificationSubmissionUserCreated subUid smid
-        -- change is an old user that is not a submission user anymore => delete invitation / delete
-        | otherwise -> case change of
-          Left subEmail -> deleteInvitation @SubmissionUser smid subEmail
-          Right subUid  -> do
-            deleteBy $ UniqueSubmissionUser subUid smid
-            audit $ TransactionSubmissionUserDelete smid subUid
-            unless (Just subUid == muid) $
-              queueDBJob . JobQueueNotification $ NotificationSubmissionUserDeleted subUid shid smid
-
-      addMessageI Success $ if | Nothing <- msmid -> MsgSubmissionCreated
-                               | otherwise        -> MsgSubmissionUpdated
-      Just <$> encrypt smid
-
-  case mCID of
-    Just cID -> do
-      let showRoute  = CSubmissionR tid ssh csh shn cID SubShowR
-      mayShow <- hasReadAccessTo showRoute
-      if
-        | mayShow   -> redirect showRoute
-        | otherwise -> redirect $ CSheetR tid ssh csh shn SShowR
-    Nothing  -> return ()
-
-  (Entity shid Sheet{..}, _, lastEdits, maySubmit, _, _, msubmission, corrector) <- runDB getSheetInfo
-
-  (showCorrection, correctionInvisible) <- fmap (fromMaybe (False, Nothing)) . for ((,) <$> mcid <*> (Entity <$> msmid <*> msubmission)) $ \(cid, subEnt) -> runDB $ do
-    showCorrection <- hasReadAccessTo $ CSubmissionR tid ssh csh shn cid CorrectionR
-    correctionInvisible <- correctionInvisibleWidget tid ssh csh shn cid subEnt
-
-    return (showCorrection, correctionInvisible)
-
-  -- Maybe construct a table to display uploaded archive files
-  let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerFor UniWorX) ())
-      colonnadeFiles cid = mconcat $ catMaybes
-        [ Just . sortable (Just "path") (i18nCell MsgTableFileTitle) $ \(mOrig, mCorr) -> let
-              Just fileTitle' = submissionFileTitle . entityVal <$> (mOrig <|> mCorr)
-              origIsFile = fmap (isJust . submissionFileContent . entityVal) mOrig
-              corrIsFile = fmap (isJust . submissionFileContent . entityVal) mCorr
-              Just isFile = origIsFile <|> corrIsFile
-            in if
-              | Just True <- origIsFile -> anchorCell (subDownloadLink cid SubmissionOriginal fileTitle') [whamlet|#{fileTitle'}|]
-              | otherwise               -> textCell $ bool (<> "/") id isFile fileTitle'
-        , guardOn showCorrection . sortable (toNothing "state") (i18nCell MsgTableCorState) $ \(_, mCorr) -> case mCorr of
-            Nothing -> cell mempty
-            Just (Entity _ SubmissionFile{..})
-              | isJust submissionFileContent -> anchorCell (subDownloadLink cid SubmissionCorrected submissionFileTitle) (i18n MsgFileCorrected :: Widget)
-              | otherwise -> i18nCell MsgCorrected
-        , Just . sortable (Just "time") (i18nCell MsgTableFileModified) $ \(mOrig, mCorr) -> let
-              origTime = submissionFileModified . entityVal <$> mOrig
-              corrTime = submissionFileModified . entityVal <$> mCorr
-              Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
-            in dateTimeCell fileTime
         ]
-      subDownloadLink cid sft fileTitle' = CSubmissionR tid ssh csh shn cid $ SubDownloadR sft fileTitle'
+      guardM . lift . E.selectExists . E.from $ \(submissionUser `E.InnerJoin` (otherSubmissionUser `E.InnerJoin` submission)) -> do
-      submissionFiles :: _ -> _ -> E.SqlQuery _
+        E.on $ otherSubmissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-      submissionFiles smid (sf1 `E.FullOuterJoin` sf2) = do
+        E.on $ submissionUser E.^. SubmissionUserSubmission E.!=. otherSubmissionUser E.^. SubmissionUserSubmission
-        E.on $ sf1 E.?. SubmissionFileTitle E.==. sf2 E.?. SubmissionFileTitle
+         E.&&. submissionUser E.^. SubmissionUserUser E.==. otherSubmissionUser E.^. SubmissionUserUser
-         E.&&. sf1 E.?. SubmissionFileSubmission E.==. sf2 E.?. SubmissionFileSubmission
+        E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
-         E.&&. sf1 E.?. SubmissionFileId E.!=. sf2 E.?. SubmissionFileId
+             E.&&. submission E.^. SubmissionId E.!=. E.val subId
-         E.&&. sf2 E.?. SubmissionFileIsDeletion E.==. E.val (Just False)
+             E.&&. submissionUser E.^. SubmissionUserSubmission E.==. E.val subId
+      return $ notification NotificationBroad =<< messageIconI Warning IconSubmissionUserDuplicate MsgSubmissionSomeUsersDuplicateWarning
 
-        E.where_ $ (sf1 E.?. SubmissionFileIsUpdate E.==. E.val (Just False) E.||. E.isNothing (sf1 E.?. SubmissionFileIsUpdate))
+    subUsers <- maybeT (return []) $ do
-             E.&&. (sf2 E.?. SubmissionFileIsUpdate E.==. E.val (Just True)  E.||. E.isNothing (sf2 E.?. SubmissionFileIsUpdate))
+      subId <- hoistMaybe msmid
-             E.&&. (sf2 E.?. SubmissionFileIsDeletion E.==. E.val (Just False)  E.||. E.isNothing (sf2 E.?. SubmissionFileIsDeletion))
+      let
-             E.&&. (sf1 E.?. SubmissionFileSubmission E.==. E.val (Just smid) E.||. sf2 E.?. SubmissionFileSubmission E.==. E.val (Just smid))
+        getUserAuthorshipStatement :: UserId
+                                   -> DB AuthorshipStatementSubmissionState
+        getUserAuthorshipStatement uid = runConduit $
+               getStmts
+            .| fmap toRes (execWriterC . C.mapM_ $ tell . toPoint)
+          where
+            getStmts = E.selectSource . E.from $ \authorshipStatementSubmission -> do
+              E.where_ $ authorshipStatementSubmission E.^. AuthorshipStatementSubmissionSubmission E.==. E.val subId
+                   E.&&. authorshipStatementSubmission E.^. AuthorshipStatementSubmissionUser E.==. E.val uid
+              return authorshipStatementSubmission
+            toPoint :: Entity AuthorshipStatementSubmission -> Maybe Any
+            toPoint (Entity _ AuthorshipStatementSubmission{..}) = Just . Any $ fmap entityKey mASDefinition == Just authorshipStatementSubmissionStatement
+            toRes :: Maybe Any -> AuthorshipStatementSubmissionState
+            toRes = \case
+              Just (Any True) -> ASExists
+              Just (Any False) -> ASOldStatement
+              Nothing -> ASMissing
+      lift $ buddies
+        & bool id (maybe id (Set.insert . Right) muid) isOwner
+        & Set.toList
+        & mapMOf (traverse . _Right) (\uid -> (,,) <$> (encrypt uid :: DB CryptoUUIDUser) <*> getJust uid <*> getUserAuthorshipStatement uid)
+        & fmap (sortOn . over _Right $ (,,,) <$> views _2 userSurname <*> views _2 userDisplayName <*> views _2 userEmail <*> view _1)
 
-        return (sf1, sf2)
+    subUsersVisible <- orM
-      smid2ArchiveTable (smid,cid) = DBTable
+      [ return isOwner
-        { dbtSQLQuery = submissionFiles smid
+      , return isLecturer
-        , dbtRowKey = \(sf1 `E.FullOuterJoin` sf2) -> (sf1 E.?. SubmissionFileId, sf2 E.?. SubmissionFileId)
+      , return $ not sheetAnonymousCorrection
-        , dbtColonnade = colonnadeFiles cid
-        , dbtProj = dbrOutput <$> dbtProjId
-        , dbtStyle = def
-        , dbtIdent = "files" :: Text
-        , dbtSorting = mconcat
-          [ singletonMap "path" . SortColumn $ \(sf1 `E.FullOuterJoin` sf2) -> (E.unsafeSqlFunction "string_to_array" :: (E.SqlExpr (E.Value (Maybe String)), E.SqlExpr (E.Value String)) -> E.SqlExpr (E.Value [String])) (E.coalesce [sf1 E.?. SubmissionFileTitle, sf2 E.?. SubmissionFileTitle], E.val "/" :: E.SqlExpr (E.Value String))
-          , singletonMap "time" . SortColumn $ \(sf1 `E.FullOuterJoin` sf2) -> (E.unsafeSqlFunction "GREATEST" ([sf1 E.?. SubmissionFileModified, sf2 E.?. SubmissionFileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
-          ]
-        , dbtFilter = mconcat
-          [ singletonMap "may-access" . FilterColumn $ \(Any b) (sf1 `E.FullOuterJoin` (_ :: E.SqlExpr (Maybe (Entity SubmissionFile))))
-              -> E.val b E.==. (E.val showCorrection E.||. E.isJust (sf1 E.?. SubmissionFileId))
-          ]
-        , dbtFilterUI = mempty
-        , dbtParams = def
-        , dbtCsvEncode = noCsvEncode
-        , dbtCsvDecode = Nothing
-        , dbtExtraReps = []
-        }
-      archiveTableValidator = def
-        & defaultSorting [SortAscBy "path"]
-        & forceFilter "may-access" (Any True)
-  mFileTable <- traverse (runDB . dbTableWidget' archiveTableValidator) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
-
-
-  filesCorrected <- fmap (fromMaybe False) . for msmid $ \subId -> runDB . E.selectExists . E.from $ \(sFile1 `E.LeftOuterJoin` sFile2) -> do
-    E.on $ E.just (sFile1 E.^. SubmissionFileTitle) E.==. sFile2 E.?. SubmissionFileTitle
-     E.&&. E.just (sFile1 E.^. SubmissionFileSubmission) E.==. sFile2 E.?. SubmissionFileSubmission
-     E.&&. sFile1 E.^. SubmissionFileContent E.!=. E.joinV (sFile2 E.?. SubmissionFileContent)
-     E.&&. sFile1 E.^. SubmissionFileIsUpdate E.&&. E.maybe E.false E.not_ (sFile2 E.?. SubmissionFileIsUpdate)
-    E.where_ $ sFile1 E.^. SubmissionFileSubmission E.==. E.val subId
-    E.where_ $ sFile2 E.?. SubmissionFileSubmission E.==. E.just (E.val subId)
-
-  sheetTypeDesc <- liftHandler . runDB $ sheetTypeDescription sheetCourse sheetType
-
-  multipleSubmissionWarnWidget <- runDB . runMaybeT $ do
-    subId <- hoistMaybe msmid
-    cID <- hoistMaybe mcid
-    guardM . lift $ orM
-      [ hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubDelR
-      , hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID SubShowR
-      , hasWriteAccessTo $ CSubmissionR tid ssh csh shn cID CorrectionR
       , hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
       ]
-    guardM . lift . E.selectExists . E.from $ \(submissionUser `E.InnerJoin` (otherSubmissionUser `E.InnerJoin` submission)) -> do
-      E.on $ otherSubmissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
-      E.on $ submissionUser E.^. SubmissionUserSubmission E.!=. otherSubmissionUser E.^. SubmissionUserSubmission
-       E.&&. submissionUser E.^. SubmissionUserUser E.==. otherSubmissionUser E.^. SubmissionUserUser
-      E.where_ $ submission E.^. SubmissionSheet E.==. E.val shid
-           E.&&. submission E.^. SubmissionId E.!=. E.val subId
-           E.&&. submissionUser E.^. SubmissionUserSubmission E.==. E.val subId
-    return $ notification NotificationBroad =<< messageIconI Warning IconSubmissionUserDuplicate MsgSubmissionSomeUsersDuplicateWarning
 
-  defaultLayout $ do
+    return (sheetInfo, (showCorrection, correctionInvisible), mFileTable, filesCorrected, sheetTypeDesc, multipleSubmissionWarnWidget, (subUsers, subUsersVisible), isLecturer, isOwner, is _Just mASDefinition)
-    setTitleI $ MsgHeadingSubmissionEditHead tid ssh csh shn
+
+  -- TODO(AuthorshipStatements): discuss whether to display prompt for user to update their authorship statement, if lecturer changed it
+
+  let (title, heading)
+        | Just cID <- mcid, maySubmit, not isLecturer || isOwner = (MsgSubmissionTitle tid ssh csh shn cID, MsgSubmissionHeadingEdit tid ssh csh shn cID)
+        | Just cID <- mcid = (MsgSubmissionTitle tid ssh csh shn cID, MsgSubmissionHeadingShow tid ssh csh shn cID)
+        | otherwise = (MsgSubmissionTitleNew tid ssh csh shn, MsgSubmissionHeadingNew tid ssh csh shn)
+  
+  siteLayoutMsg heading $ do
+    setTitleI title
     (urlArchive, urlOriginal) <- fmap ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) . for mcid $ \cID
       -> let mkUrl sft = toTextUrl . CSubmissionR tid ssh csh shn cID $ SubArchiveR sft
           in liftHandler . runDB $ (,) <$> mkUrl SubmissionCorrected <*> mkUrl SubmissionOriginal
@@ -610,4 +660,10 @@ submissionHelper tid ssh csh shn mcid = do
                   , is _Just submissionRatingPoints, is _Just submissionRatingComment
                   ]
         correctionVisibleWarnWidget = guardOnM (is _Just msubmission && is _Just mcid && showCorrection) correctionInvisible
+        asStatusExplain = $(i18nWidgetFiles "authorship-statement-submission-explanation")
+        asStatuses = setOf (folded . _Right . _3) subUsers
+          & Set.union (Set.fromList [ASExists, ASMissing])
+          & Set.toList
+          & mapMaybe (\stmt -> (stmt, ) <$> asStatusExplain Map.!? toPathPiece stmt)
+        asStatusExplainWdgt = $(widgetFile "widgets/authorship-statement-submission-explanation")
     $(widgetFile "submission")

src/Handler/Submission/Helper/ArchiveTable.hs

@@ -0,0 +1,112 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
+module Handler.Submission.Helper.ArchiveTable
+  ( mkSubmissionArchiveTable
+  ) where
+
+import Import
+import Handler.Utils
+import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
+import qualified Database.Esqueleto.Internal.Internal as E (unsafeSqlFunction)
+
+
+type SubmissionArchiveExpr = E.SqlExpr (Maybe (Entity SubmissionFile)) `E.FullOuterJoin` E.SqlExpr (Maybe (Entity SubmissionFile))
+
+queryOriginal, queryCorrected :: Getter SubmissionArchiveExpr (E.SqlExpr (Maybe (Entity SubmissionFile)))
+queryOriginal = to $(E.sqlFOJproj 2 1)
+queryCorrected = to $(E.sqlFOJproj 2 2)
+
+
+type SubmissionArchiveData = DBRow ( Maybe (Entity SubmissionFile)
+                                   , Maybe (Entity SubmissionFile)
+                                   )
+
+resultOriginal, resultCorrected :: Traversal' SubmissionArchiveData (Entity SubmissionFile)
+resultOriginal = _dbrOutput . _1 . _Just
+resultCorrected = _dbrOutput . _2 . _Just
+  
+
+mkSubmissionArchiveTable :: TermId -> SchoolId -> CourseShorthand -> SheetName
+                         -> Bool -- ^ @showCorrection@
+                         -> SubmissionId
+                         -> DB (Bool, Widget)
+mkSubmissionArchiveTable tid ssh csh shn showCorrection smid = do
+  cID <- encrypt smid :: DB CryptoFileNameSubmission -- shouldn't be expensive due to caching
+
+  let
+    dbtIdent :: Text
+    dbtIdent = "files"
+    
+    dbtSQLQuery = runReaderT $ do
+      original <- view queryOriginal
+      corrected <- view queryCorrected
+
+      lift . E.on $
+              original E.?. SubmissionFileTitle E.==. corrected E.?. SubmissionFileTitle
+        E.&&. original E.?. SubmissionFileSubmission E.==. corrected E.?. SubmissionFileSubmission
+        E.&&. original E.?. SubmissionFileId E.!=. corrected E.?. SubmissionFileId
+        E.&&. corrected E.?. SubmissionFileIsDeletion E.==. E.val (Just False)
+        E.&&. E.val showCorrection -- Do not correlate files if we don't show correction; together with `may-access` this treats corrected files like they literally don't exist
+
+      lift . E.where_ $ original E.?. SubmissionFileSubmission E.==. E.val (Just smid)
+                  E.||. corrected E.?. SubmissionFileSubmission E.==. E.val (Just smid)
+
+      lift . E.where_ . E.maybe E.true E.not_ $ original  E.?. SubmissionFileIsUpdate -- @original@ is unset or not an update
+      lift . E.where_ . E.maybe E.true id     $ corrected E.?. SubmissionFileIsUpdate -- @corrected@ is unset or an update
+      lift . E.where_ . E.maybe E.true E.not_ $ corrected E.?. SubmissionFileIsDeletion -- @corrected@ is unset or not a deletion
+      return (original, corrected)
+    dbtRowKey = (,) <$> views queryOriginal (E.?. SubmissionFileId) <*> views queryCorrected (E.?. SubmissionFileId)
+
+    dbtProj = dbtProjId
+
+    dbtColonnade = mconcat $ catMaybes
+        [ Just . sortable (Just "path") (i18nCell MsgTableFileTitle) $ \t -> let
+              mOrig = t ^? resultOriginal
+              mCorr = t ^? resultCorrected
+              fileTitle'' = submissionFileTitle . entityVal <$> (mOrig <|> mCorr)
+              origIsFile = fmap (isJust . submissionFileContent . entityVal) mOrig
+              corrIsFile = fmap (isJust . submissionFileContent . entityVal) mCorr
+              isFile' = origIsFile <|> corrIsFile
+            in maybeCell ((,) <$> fileTitle'' <*> isFile') $ \(fileTitle', isFile) -> if
+              | Just True <- origIsFile -> anchorCell (subDownloadLink SubmissionOriginal fileTitle') [whamlet|#{fileTitle'}|]
+              | otherwise               -> textCell $ bool (<> "/") id isFile fileTitle'
+        , guardOn showCorrection . sortable (toNothing "state") (i18nCell MsgTableCorState) $ \t -> case t ^? resultCorrected of
+            Nothing -> cell mempty
+            Just (Entity _ SubmissionFile{..}) -> tellCell (Any True) $ if
+              | isJust submissionFileContent -> anchorCell (subDownloadLink SubmissionCorrected submissionFileTitle) (i18n MsgFileCorrected :: Widget)
+              | otherwise -> i18nCell MsgCorrected
+        , Just . sortable (Just "time") (i18nCell MsgTableFileModified) $ \t -> let
+              mOrig = t ^? resultOriginal
+              mCorr = t ^? resultCorrected
+              origTime = submissionFileModified . entityVal <$> mOrig
+              corrTime = submissionFileModified . entityVal <$> mCorr
+              fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime
+            in maybeCell fileTime dateTimeCell
+        ]
+      where 
+        subDownloadLink sft fileTitle' = CSubmissionR tid ssh csh shn cID $ SubDownloadR sft fileTitle'
+
+    dbtStyle = def
+
+    dbtSorting = mconcat
+        [ singletonMap "path" . SortColumn $ \r -> (E.unsafeSqlFunction "string_to_array" :: (E.SqlExpr (E.Value (Maybe String)), E.SqlExpr (E.Value String)) -> E.SqlExpr (E.Value [String])) (E.coalesce [views queryOriginal (E.?. SubmissionFileTitle) r, views queryCorrected (E.?. SubmissionFileTitle) r], E.val "/" :: E.SqlExpr (E.Value String))
+        , singletonMap "time" . SortColumn $ \r -> (E.unsafeSqlFunction "GREATEST" ([views queryOriginal (E.?. SubmissionFileModified) r, views queryCorrected (E.?. SubmissionFileModified) r] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
+        ]
+    dbtFilter = mconcat
+        [ singletonMap "may-access" . FilterColumn $ \(Any b) r
+            -> E.val b E.==. (E.val showCorrection E.||. E.isJust (views queryOriginal (E.?. SubmissionFileId) r))
+        ]
+
+    dbtFilterUI = mempty
+
+    dbtParams = def
+
+    dbtCsvEncode = noCsvEncode
+    dbtCsvDecode = Nothing
+    dbtExtraReps = []
+
+    archiveTableValidator = def
+      & defaultSorting [SortAscBy "path"]
+      & forceFilter "may-access" (Any True)
+   in over _1 getAny <$> dbTableWidget archiveTableValidator DBTable{..}

src/Handler/Submission/List.hs

@@ -154,7 +154,7 @@ colSMatrikel = sortable (Just "submittors-matriculation") (i18nCell MsgTableMatr
 
 colSGroups :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
 colSGroups = sortable (Just "submittors-group") (i18nCell MsgTableSubmissionGroup) $ \DBRow{ dbrOutput=(_, Entity _ Sheet{..}, _, _, _, users, _, hasAccess) } ->
-  let protoCell = listCell (nubOn (view _2) . Map.toList $ Map.mapMaybe (view _3) users) $ \(_, sGroup) -> cell $ toWidget sGroup
+  let protoCell = listCell (nubOrdOn (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")]
@@ -680,13 +680,13 @@ postCorrectionsR = do
         ]
       courseOptions = runDB $ do
         courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . courseShorthand . entityVal) courses
       termOptions = runDB $ do
         courses <- selectList [] [Desc CourseTerm]      >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (termToText . unTermKey . courseTerm . entityVal) courses
       schoolOptions = runDB $ do
         courses <- selectList [] [Asc CourseSchool]    >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
-        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
+        optionsPairs . map (id &&& id) . nubOrd $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses
 
       psValidator = def
         & restrictCorrector

src/Handler/Submission/SubmissionUserInvite.hs

@@ -7,8 +7,10 @@ module Handler.Submission.SubmissionUserInvite
   ) where
 
 import Import
+import Utils.Form
 
 import Handler.Utils.Invitations
+import Handler.Utils.AuthorshipStatement
 
 import Data.Aeson hiding (Result(..))
 
@@ -79,8 +81,18 @@ submissionUserInvitationConfig = InvitationConfig{..}
           itStartsAt = Nothing
       return InvitationTokenConfig{..}
     invitationRestriction _ _ = return Authorized
-    invitationForm _ _ _ = pure (JunctionSubmissionUser, ())
+    invitationForm (Entity _ Submission{..}) _ _ = wFormToAForm $ do
-    invitationInsertHook _ _ _ _ _ = id
+      -- TODO(AuthorshipStatements): allow invitee to download submission files/see co-submittors iff authorship-statement is required
+      authorshipStatementRes <- maybeT (return $ FormSuccess Nothing) . fmap (fmap Just) $ do
+        sheetEnt <- lift . lift . lift $ getJustEntity submissionSheet
+        asd <- MaybeT . lift . lift $ getSheetAuthorshipStatement sheetEnt
+        lift $ wpopt (acceptAuthorshipStatementField asd) (fslI MsgSubmissionAuthorshipStatement & setTooltip MsgSubmissionAuthorshipStatementTip) Nothing
+      return $ (JunctionSubmissionUser, ) <$> authorshipStatementRes
+    invitationInsertHook _ (Entity smid _) _ SubmissionUser{..} masdId act = do
+      for_ masdId $ \asdId -> do
+        now <- liftIO getCurrentTime
+        insert_ $ AuthorshipStatementSubmission asdId smid submissionUserUser now
+      act
     invitationSuccessMsg (Entity _ Submission{..}) _ = do
       Sheet{..} <- getJust submissionSheet
       return . SomeMessage $ MsgSubmissionUserInvitationAccepted sheetName

src/Handler/SystemMessage.hs

@@ -21,6 +21,12 @@ import qualified Database.Esqueleto.Legacy as E
 
 -- htmlField' moved to Handler.Utils.Form/Fields
 
+invalidateVisibleSystemMessages :: (MonadHandler m, HandlerSite m ~ UniWorX)
+                                => m ()
+invalidateVisibleSystemMessages
+  = memcachedByInvalidate AuthCacheVisibleSystemMessages $ Proxy @(Map SystemMessageId (Maybe UTCTime, Maybe UTCTime))
+  
+
 getMessageR, postMessageR :: CryptoUUIDSystemMessage -> Handler Html
 getMessageR = postMessageR
 postMessageR cID = do
@@ -138,6 +144,7 @@ postMessageR cID = do
   where
     modifySystemMessage smId sm = do
       runDB $ replace smId sm
+      invalidateVisibleSystemMessages
       addMessageI Success MsgSystemMessageEditSuccess
       redirect $ MessageR cID
 
@@ -258,18 +265,21 @@ postMessageListR = do
       | not $ null selection -> do
           selection' <- traverse decrypt $ Set.toList selection
           runDB $ deleteWhere [ SystemMessageId <-. selection' ]
+          invalidateVisibleSystemMessages
           $(addMessageFile Success "templates/messages/systemMessagesDeleted.hamlet")
           redirect MessageListR
     FormSuccess (SMDActivate ts, selection)
       | not $ null selection -> do
           selection' <- traverse decrypt $ Set.toList selection
           runDB $ updateWhere [ SystemMessageId <-. selection' ] [ SystemMessageFrom =. ts ]
+          invalidateVisibleSystemMessages
           $(addMessageFile Success "templates/messages/systemMessagesSetFrom.hamlet")
           redirect MessageListR
     FormSuccess (SMDDeactivate ts, selection)
       | not $ null selection -> do
           selection' <- traverse decrypt $ Set.toList selection
           runDB $ updateWhere [ SystemMessageId <-. selection' ] [ SystemMessageTo =. ts ]
+          invalidateVisibleSystemMessages
           $(addMessageFile Success "templates/messages/systemMessagesSetTo.hamlet")
           redirect MessageListR
     FormSuccess (_, _selection) -- prop> null _selection

src/Handler/Utils.hs

@@ -25,6 +25,7 @@ import Handler.Utils.Occurrences as Handler.Utils
 import Handler.Utils.Memcached  as Handler.Utils hiding (manageMemcachedLocalInvalidations)
 import Handler.Utils.Files      as Handler.Utils
 import Handler.Utils.Download   as Handler.Utils
+import Handler.Utils.AuthorshipStatement as Handler.Utils
 
 import Handler.Utils.Term as Handler.Utils
 

src/Handler/Utils/AuthorshipStatement.hs

@@ -0,0 +1,125 @@
+module Handler.Utils.AuthorshipStatement
+  ( insertAuthorshipStatement
+  , forcedAuthorshipStatementField
+  , authorshipStatementWidget
+  , getSheetAuthorshipStatement
+  , acceptAuthorshipStatementField
+  ) where
+
+import Import
+import Utils.Form
+
+import qualified Data.Map.Strict as Map
+
+import Handler.Utils.Form (i18nLangMap, I18nLang(..))
+
+import qualified Database.Esqueleto.Legacy as E
+import qualified Database.Esqueleto.Utils as E
+
+import qualified Data.ByteString.Base64.URL as Base64
+import qualified Data.ByteArray as BA
+
+
+insertAuthorshipStatement :: MonadIO m
+                          => I18nStoredMarkup -> SqlWriteT m AuthorshipStatementDefinitionId
+insertAuthorshipStatement authorshipStatementDefinitionContent = withCompatibleBackend @SqlBackend $ do
+  let authorshipStatementDefinitionHash = toAuthorshipStatementReference authorshipStatementDefinitionContent
+  unlessM (exists [AuthorshipStatementDefinitionHash ==. authorshipStatementDefinitionHash]) $
+    insert_ AuthorshipStatementDefinition{..}
+  return $ AuthorshipStatementDefinitionKey authorshipStatementDefinitionHash
+
+forcedAuthorshipStatementField :: (MonadHandler handler, HandlerSite handler ~ UniWorX)
+                               => Field handler AuthorshipStatementDefinition
+forcedAuthorshipStatementField = Field{..}
+  where
+    fieldParse _ _ = pure . Left $ SomeMessage ("Result of forcedAuthorshipStatementField inspected" :: Text)
+    fieldEnctype = UrlEncoded
+    fieldView theId _name attrs (preview _Right -> mVal) _isReq
+      = [whamlet|
+          $newline never
+          <div ##{theId} *{attrs}>
+            ^{maybe mempty authorshipStatementWidget mVal}
+        |]
+
+authorshipStatementWidget :: AuthorshipStatementDefinition -> Widget
+authorshipStatementWidget AuthorshipStatementDefinition{..}
+  = [whamlet|
+      $newline never
+      <dl .authorship-statement>
+        $forall (I18nLang l, t) <- Map.toList (review i18nLangMap authorshipStatementDefinitionContent)
+          <dt>
+            _{MsgLanguageEndonym l}
+          <dd>
+            #{markupOutput t}
+
+      <p .authorship-statement__id>
+        #{hashText}
+    |]
+  where hashText = decodeUtf8 . Base64.encodeUnpadded $ BA.convert authorshipStatementDefinitionHash
+
+acceptAuthorshipStatementField :: forall m.
+                                  (MonadHandler m, HandlerSite m ~ UniWorX)
+                               => Entity AuthorshipStatementDefinition
+                               -> Field m AuthorshipStatementDefinitionId
+acceptAuthorshipStatementField (Entity asdId asd)
+    = checkBoxField
+    & _fieldView %~ adjFieldView
+    & checkMap (bool (Left MsgAuthorshipStatementStatementIsRequired) (Right asdId)) (== asdId)
+  where
+    adjFieldView :: FieldViewFunc m Bool -> FieldViewFunc m Bool
+    adjFieldView checkboxView theId theName attrs val isReq = do
+      let checkboxWdgt = checkboxView checkboxId theName [] val isReq
+          checkboxId = theId <> "__checkbox"
+      $(widgetFile "widgets/authorship-statement-accept")
+
+
+getSheetAuthorshipStatement :: MonadIO m
+                            => Entity Sheet
+                            -> SqlReadT m (Maybe (Entity AuthorshipStatementDefinition))
+getSheetAuthorshipStatement (Entity _ Sheet{..}) = withCompatibleBackend @SqlBackend $ traverse getJustEntity <=< runMaybeT $ do
+  Entity _ School{..} <- MaybeT . E.selectMaybe . E.from $ \(school `E.InnerJoin` course) -> do
+    E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool
+    E.where_ $ course E.^. CourseId E.==. E.val sheetCourse
+    return school
+
+  let examId = fmap Right sheetAuthorshipStatementExam
+           <|> fmap Left (sheetType ^? _examPart . re _SqlKey)
+           <|> fmap Right sheetRequireExamRegistration
+  exam <- lift . for examId $ \case
+    Right e -> getJust e
+    Left epId -> getJust epId >>= getJust . examPartExam
+
+  let
+    examAuthorshipStatement' = exam >>= examAuthorshipStatement
+    sheetAuthorshipStatement' = guardOnM (is _SheetAuthorshipStatementModeEnabled sheetAuthorshipStatementMode) sheetAuthorshipStatement
+    sheetDoAuthorshipStatements
+      =     is _SheetAuthorshipStatementModeEnabled sheetAuthorshipStatementMode
+        || (is _SheetAuthorshipStatementModeExam sheetAuthorshipStatementMode && is _Just examAuthorshipStatement')
+
+  if
+    | is _Just exam
+    , is _SchoolAuthorshipStatementModeNone schoolSheetExamAuthorshipStatementMode
+      -> mzero
+    | is _Just exam
+    , not schoolSheetExamAuthorshipStatementAllowOther
+      -> guardOnM (is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode || sheetDoAuthorshipStatements) $ hoistMaybe schoolSheetExamAuthorshipStatementDefinition
+    | is _Just exam
+    , is _SchoolAuthorshipStatementModeRequired schoolSheetExamAuthorshipStatementMode
+      -> hoistMaybe $ sheetAuthorshipStatement'
+                  <|> guardOnM (is _SheetAuthorshipStatementModeExam sheetAuthorshipStatementMode) examAuthorshipStatement'
+                  <|> schoolSheetExamAuthorshipStatementDefinition
+
+    | is _Nothing exam
+    , is _SchoolAuthorshipStatementModeNone schoolSheetAuthorshipStatementMode
+      -> mzero
+    | is _Nothing exam
+    , not schoolSheetAuthorshipStatementAllowOther
+      -> guardOnM (is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode || sheetDoAuthorshipStatements) $ hoistMaybe schoolSheetAuthorshipStatementDefinition
+    | is _Nothing exam
+    , is _SchoolAuthorshipStatementModeRequired schoolSheetAuthorshipStatementMode
+      -> hoistMaybe $ sheetAuthorshipStatement' <|> schoolSheetAuthorshipStatementDefinition
+
+    | otherwise
+      -> case exam of
+           Just _  -> hoistMaybe $ sheetAuthorshipStatement' <|> examAuthorshipStatement'
+           Nothing -> hoistMaybe   sheetAuthorshipStatement'

src/Handler/Utils/Communication.hs

@@ -146,12 +146,12 @@ commR CommunicationRoute{..} =  do
   let recipientAForm :: AForm Handler (Set (Either UserEmail UserId))
       recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients')
         where
-          miAdd (BoundedPosition RecipientCustom, 0) 1 nudge submitView = Just $ \csrf -> do
+          miAdd pos@(BoundedPosition RecipientCustom, 0) dim@1 liveliness nudge submitView = guardOn (miAllowAdd pos dim liveliness) $ \csrf -> do
             (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgUtilEMail (mr MsgUtilEMail) & setTooltip MsgUtilMultiEmailFieldTip & addName (nudge "email")) Nothing
             let
               addRes' = addRes <&> \nEmails ((Map.elems &&& maybe 0 (succ . snd . fst) . Map.lookupMax) . Map.filterWithKey (\(BoundedPosition c, _) _ -> c == RecipientCustom) -> (oEmails, kStart)) -> FormSuccess . Map.fromList . zip (map (BoundedPosition RecipientCustom, ) [kStart..]) . Set.toList $ nEmails `Set.difference` Set.fromList oEmails
             return (addRes', $(widgetFile "widgets/communication/recipientAdd"))
-          miAdd _ _ _ _ = Nothing
+          miAdd _ _ _ _ _ = Nothing
           miCell _ (Left (CI.original -> email)) initRes nudge csrf = do
             (tickRes, tickView) <- mpreq checkBoxField ("" & addName (nudge "tick")) $ initRes <|> Just True
             return (tickRes, $(widgetFile "widgets/communication/recipientEmail"))

src/Handler/Utils/Form.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+
 module Handler.Utils.Form
   ( module Handler.Utils.Form
   , module Handler.Utils.Form.MassInput
@@ -60,7 +62,7 @@ import Data.Aeson.Text (encodeToLazyText)
 import qualified Text.Email.Validate as Email
 
 import Data.Text.Lens (unpacked)
-import Text.Blaze (toMarkup)
+import Text.Blaze (toMarkup, Markup)
 
 import Handler.Utils.Form.MassInput
 
@@ -74,6 +76,8 @@ import qualified Data.Yaml as Yaml
 
 import Control.Monad.Catch.Pure (runCatch)
 
+import qualified Data.List.NonEmpty as NonEmpty
+  
 {-# ANN module ("HLint: ignore Use const" :: String) #-}
 
 
@@ -458,6 +462,15 @@ explainedMultiActionA :: forall action a.
                       -> AForm Handler a
 explainedMultiActionA acts mActsOpts fSettings defAction = formToAForm $ explainedMultiAction acts mActsOpts fSettings defAction mempty
 
+explainedMultiActionW :: forall action a.
+                         Ord action
+                      => Map action (AForm Handler a)
+                      -> Handler ([(Option action, Maybe Widget)], Text -> Maybe action)
+                      -> FieldSettings UniWorX
+                      -> Maybe action
+                      -> WForm Handler (FormResult a)
+explainedMultiActionW acts mActsOpts fSettings defAction = aFormToWForm $ explainedMultiActionA acts mActsOpts fSettings defAction
+
 ------------
 -- Fields --
 ------------
@@ -696,7 +709,7 @@ uploadModeForm fs prev = multiActionA actions fs (classifyUploadMode <$> prev)
                  , $(widgetFile "widgets/massinput/uploadSpecificFiles/form")
                  )
 
-        miAdd _ _ nudge submitView = Just $ \csrf -> do
+        miAdd _ _ _ nudge submitView = Just $ \csrf -> do
           (formRes, formWidget) <- sFileForm nudge Nothing csrf
           let formWidget' = $(widgetFile "widgets/massinput/uploadSpecificFiles/add")
               addRes' = formRes <&> \fileRes oldRess ->
@@ -707,7 +720,6 @@ uploadModeForm fs prev = multiActionA actions fs (classifyUploadMode <$> prev)
           sFileForm nudge (Just initFile) csrf
         miDelete :: MassInputDelete ListLength
         miDelete = miDeleteList
-        miAllowAdd _ _ _ = True
         miAddEmpty _ _ _ = Set.empty
         miLayout :: MassInputLayout ListLength UploadSpecificFile UploadSpecificFile
         miLayout lLength _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/massinput/uploadSpecificFiles/layout")
@@ -2345,3 +2357,175 @@ roomReferenceForm' noneOpt fs mPrev = multiActionAOpts opts opts' fs $ fmap clas
               <$> roomRefLink'
               <*> roomRefInstructions'
         return $ Just <$> res
+
+newtype I18nLangs = I18nLangs { unI18nLangs :: Set I18nLang }
+  deriving newtype (ToJSON, FromJSON, MonoFoldable, Semigroup, Monoid, Lattice, BoundedJoinSemiLattice)
+  deriving (Eq, Ord, Generic, Typeable, Read, Show)
+type instance Element I18nLangs = I18nLang
+
+newtype I18nLang = I18nLang { unI18nLang :: Lang }
+  deriving newtype (PathPiece, ToJSON, FromJSON, ToJSONKey, FromJSONKey)
+  deriving (Eq, Generic, Typeable, Read, Show)
+
+instance Ord I18nLang where
+  compare = mconcat
+    [ comparing $ NTop . flip elemIndex (toList appLanguages) . unI18nLang
+    , comparing $ T.splitOn "-" . unI18nLang
+    ]
+
+makeWrapped ''I18nLangs
+makeWrapped ''I18nLang
+
+instance IsBoxCoord I18nLang where
+  boxDimensions = [BoxDimension _Wrapped]
+  boxOrigin = _Wrapped # NonEmpty.head appLanguages
+
+instance Liveliness I18nLangs where
+  type BoxCoord I18nLangs = I18nLang
+  liveCoords = from _Wrapped
+
+i18nLangMap :: Prism' (Map I18nLang a) (I18n a)
+i18nLangMap = prism' toLangMap fromLangMap
+  where
+    -- ugh.
+    toLangMap I18n{..} = Map.mapKeys I18nLang $ if
+      | Just fLang <- i18nFallbackLang
+        -> Map.insert fLang i18nFallback i18nTranslations
+      | missing : _ <- sortOn langSortProj . toList $ setOf folded appLanguages `Set.difference` Map.keysSet i18nTranslations
+        -> Map.insert missing i18nFallback i18nTranslations
+      | otherwise
+        -> Map.insert (NonEmpty.head appLanguages) i18nFallback i18nTranslations
+    fromLangMap lMap = do
+      (Just -> i18nFallbackLang, i18nFallback) : i18nTranslations' <- return
+        $ Map.toList lMap
+        & over (traverse . _1) (view _Wrapped)
+        & sortOn (views _1 langSortProj)
+      let i18nTranslations = Map.fromList i18nTranslations'
+      return I18n{..}
+
+    langSortProj = NTop . flip elemIndex (toList appLanguages)
+
+i18nForm :: forall a ident handler.
+            ( PathPiece ident
+            , MonadHandler handler, HandlerSite handler ~ UniWorX
+            , MonadThrow handler
+            )
+         => ((Text -> Text) -> Maybe a -> (Markup -> MForm handler (FormResult a, Widget)))
+         -> Bool -- ^ Allow only languages from `appLanguages`?
+         -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
+         -> ident
+         -> FieldSettings UniWorX
+         -> Bool
+         -> Maybe (Maybe (I18n a))
+         -> (Markup -> MForm handler (FormResult (Maybe (I18n a)), FieldView UniWorX))
+i18nForm strForm onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' csrf'
+  = fmap (over _1 massageFormResult) . ($ csrf') . massInput MassInput{..} fSettings fRequired $ fmap ((), ) . review i18nLangMap <$> join mPrev'
+  where
+    massageFormResult :: FormResult (Map I18nLang ((), a)) -> FormResult (Maybe (I18n a))
+    massageFormResult = fmap $ preview i18nLangMap . map (view _2)
+
+    miAdd :: I18nLang -> Natural -> I18nLangs
+          -> (Text -> Text) -> FieldView UniWorX
+          -> Maybe (Markup -> MForm handler (FormResult (Map I18nLang () -> FormResult (Map I18nLang ())), Widget))
+    miAdd _pos _dimIx liveliness nudge submitBtn = guardOn (not $ onlyAppLanguages && null (missingLangs liveliness)) $ \csrf -> do
+        let langField' :: Field Handler Lang
+            langField'
+              | onlyAppLanguages = selectField langOpts
+              | otherwise = textField
+                          & addDatalist langOpts
+                          & cfStrip
+                          & checkBool langCheck MsgInvalidLangFormat
+              where
+                langOpts = do
+                  MsgRenderer mr <- getMsgRenderer
+                  let mkOption l = Option
+                        { optionDisplay = mr $ MsgLanguage l
+                        , optionInternalValue = l
+                        , optionExternalValue = l
+                        }
+                  return OptionList
+                    { olOptions = map (views _Wrapped mkOption) $ missingLangs liveliness
+                    , olReadExternal = if
+                        | onlyAppLanguages -> assertM' (`elem` toList appLanguages)
+                        | otherwise -> Just
+                    }
+                langCheck (T.splitOn "-" -> lParts)
+                  = all ((&&) <$> not . null <*> T.all Char.isAlpha) lParts
+                 && not (null lParts)
+
+        (langRes, langView) <- mpreq (hoistField liftHandler langField' & isoField _Unwrapped) (def & addName (nudge "lang")) $ missingLangs liveliness ^? _head
+
+        MsgRenderer mr <- getMsgRenderer
+        let res = langRes <&> \newLang oldLangs -> if
+              | newLang `Map.member` oldLangs -> FormFailure . pure . mr . MsgI18nFormLanguageAlreadyExists $ newLang ^. _Wrapped
+              | otherwise -> pure $ Map.singleton newLang ()
+
+        return (res, $(widgetFile "widgets/i18n-form/add"))
+      where
+        missingLangs liveliness' = Set.toAscList $ setOf (folded . re _Wrapped) appLanguages `Set.difference` view _Wrapped liveliness'
+
+    miCell :: I18nLang -> () -> Maybe a
+           -> (Text -> Text)
+           -> (Markup -> MForm handler (FormResult a, Widget))
+    miCell _ _ mPrev nudge csrf = do
+      (strRes, strView) <- strForm nudge mPrev csrf
+      return (strRes, $(widgetFile "widgets/i18n-form/cell"))
+
+    miDelete :: Map I18nLang ()
+             -> I18nLang
+             -> MaybeT (MForm handler) (Map I18nLang I18nLang)
+    miDelete liveliness' coord = return . Map.delete coord . Map.fromSet id $ Map.keysSet liveliness'
+
+    miAddEmpty :: I18nLang
+               -> Natural
+               -> I18nLangs
+               -> Set I18nLang
+    miAddEmpty _ _ _ = Set.empty
+
+    miLayout :: MassInputLayout I18nLangs () a
+    miLayout (I18nLangs langs) _ cellWdgts delButtons addWdgts = $(widgetFile "widgets/i18n-form/layout")
+
+i18nField :: forall a ident handler.
+             ( PathPiece ident
+             , MonadHandler handler, HandlerSite handler ~ UniWorX
+             , MonadThrow handler
+             )
+          => Field handler a
+          -> Bool -- ^ Allow only languages from `appLanguages`?
+          -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
+          -> ident
+          -> FieldSettings UniWorX
+          -> Bool
+          -> Maybe (Maybe (I18n a))
+          -> (Markup -> MForm handler (FormResult (Maybe (I18n a)), FieldView UniWorX))
+i18nField strField = i18nForm $ \nudge mPrev csrf -> over _2 ((toWidget csrf <>) . fvWidget) <$> mpreq strField (def & addName (nudge "string")) mPrev
+
+i18nFieldA :: forall a ident handler.
+              ( PathPiece ident
+              , MonadHandler handler, HandlerSite handler ~ UniWorX
+              , MonadThrow handler
+              )
+           => Field handler a
+           -> Bool -- ^ Allow only languages from `appLanguages`?
+           -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
+           -> ident
+           -> FieldSettings UniWorX
+           -> Bool
+           -> Maybe (Maybe (I18n a))
+           -> AForm handler (Maybe (I18n a))
+i18nFieldA strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' = formToAForm $ over _2 pure <$> i18nField strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' mempty
+
+i18nFieldW :: forall a ident handler.
+              ( PathPiece ident
+              , MonadHandler handler, HandlerSite handler ~ UniWorX
+              , MonadThrow handler
+              )
+           => Field handler a
+           -> Bool -- ^ Allow only languages from `appLanguages`?
+           -> (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX))
+           -> ident
+           -> FieldSettings UniWorX
+           -> Bool
+           -> Maybe (Maybe (I18n a))
+           -> WForm handler (FormResult (Maybe (I18n a)))
+i18nFieldW strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev' = aFormToWForm $ i18nFieldA strField onlyAppLanguages miButtonAction miIdent fSettings fRequired mPrev'

src/Handler/Utils/Form/MassInput.hs

@@ -35,6 +35,9 @@ import Text.Hamlet (hamletFile)
 
 import Algebra.Lattice.Ordered (Ordered(..))
 
+import Control.Monad.Trans.RWS.Lazy (evalRWST)
+import qualified Control.Monad.State.Class as State
+
 {-# ANN module ("HLint: ignore Use const" :: String) #-}
 
 
@@ -244,10 +247,11 @@ data MassInputException = MassInputInvalidShape
 instance Exception MassInputException
 
 data MassInput handler liveliness cellData cellResult = forall i. PathPiece i => MassInput
-  { miAdd :: BoxCoord liveliness -- Position (dimensions after @dimIx@ are zero)
+  { miAdd :: BoxCoord liveliness -- ^ Position (dimensions after @dimIx@ are zero)
-          -> Natural -- Zero-based dimension index @dimIx@
+          -> Natural -- ^ Zero-based dimension index @dimIx@
-          -> (Text -> Text) -- Nudge deterministic field ids
+          -> liveliness -- ^ Previous liveliness
-          -> FieldView UniWorX -- Submit button
+          -> (Text -> Text) -- ^ Nudge deterministic field ids
+          -> FieldView UniWorX -- ^ Submit button
           -> Maybe (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) cellData -> FormResult (Map (BoxCoord liveliness) cellData)), Widget)) -- ^ Construct a Cell-Addition Widget
   , miCell :: BoxCoord liveliness -- Position
            -> cellData -- @cellData@ from @miAdd@
@@ -257,10 +261,6 @@ data MassInput handler liveliness cellData cellResult = forall i. PathPiece i =>
   , miDelete :: Map (BoxCoord liveliness) cellData
              -> BoxCoord liveliness
              -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness)) -- ^ Decide whether a deletion-operation should be permitted and produce a finite map of new coordinates to their old correspondants
-  , miAllowAdd :: BoxCoord liveliness
-               -> Natural
-               -> liveliness
-               -> Bool -- ^ Decide whether an addition-operation should be permitted
   , miAddEmpty :: BoxCoord liveliness
                -> Natural
                -> liveliness
@@ -315,74 +315,88 @@ massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvR
     | otherwise -> throwM MassInputInvalidShape
   sentLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet sentShape' ^? liveCoords :: MForm handler liveliness
 
-  let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (Maybe (Map (BoxCoord liveliness) cellData -> FormResult (Map (BoxCoord liveliness) cellData))), Maybe Widget))
+  let runTwice :: (Maybe res -> MForm handler res) -> MForm handler res
-      addForm = addForm' boxOrigin [] . zip [0..]
+      runTwice act = do
-        where
+        r <- ask
-          addForm' _ _ [] = return Map.empty
+        s <- State.get
-          addForm' miCoord pDims (dim''@(dimIx, _) : remDims) = do
+        res1 <- fmap (view _1) . lift $ evalRWST (act Nothing) r s 
-            let nudgeAddWidgetName :: Text -> Text
+        local (_1 .~ Nothing) . act $ Just res1
-                nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
+      replaceWithFirst :: forall k x y. Ord k => Maybe (Map k (x, y)) -> Map k (x, y) -> Map k (x, y)
-            (btnRes', btnView) <- mopt (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..} & addFormAction) Nothing
+      replaceWithFirst Nothing xs = xs
-            let btnRes = do
+      replaceWithFirst (Just f) s = Map.unionWith (\(f1, _f2) (_s1, s2) -> (f1, s2)) f s
-                  Just x <- btnRes'
-                  return x
-                wBtnRes res = do
-                  guard $ isn't _FormMissing btnRes
-                  res
-                miAdd' = traverse ($ mempty) $ miAdd miCoord dimIx nudgeAddWidgetName btnView
-            addRes'' <- miAdd' <&> (_Just . _1) %~ wBtnRes
-            addRes' <- fmap join . for addRes'' $ bool (return . Just) (\(res, _view) -> set (_Just . _1) res <$> local (set _1 Nothing) miAdd') (is (_Just . _FormSuccess) (fst <$> addRes'') || is _FormMissing btnRes)
-            let dimRes' = Map.singleton (dimIx, miCoord) (maybe (Nothing <$ btnRes) (fmap Just . fst) addRes', fmap snd addRes')
-            case remDims of
-              [] -> return dimRes'
-              ((_, BoxDimension dim) : _) -> do
-                let miCoords
-                      = Set.union (miAddEmpty miCoord dimIx sentLiveliness)
-                      . Set.map (\c -> miCoord & dim .~ (c ^. dim))
-                      . Set.filter (\c -> and [ ((==) `on` view pDim) miCoord c | (_, BoxDimension pDim) <- pDims `snoc` dim'' ])
-                      $ review liveCoords sentLiveliness
-                dimRess <- sequence $ Map.fromSet (\c -> addForm' c (pDims `snoc` dim'') remDims) miCoords
-                return $ dimRes' `Map.union` fold dimRess
  
-  addResults <- addForm boxDimensions
+  (shape, liveliness, delShapeUpdate, addResults, addResults', delResults, shapeChanged) <- runTwice $ \mPrev -> do
-  let
+    let sentLiveliness' = maybe sentLiveliness (view _2) mPrev
-    addResults' :: Map (Natural, BoxCoord liveliness) (FormResult (Maybe (Map (BoxCoord liveliness) cellData)))
+
-    addResults' = flip Map.mapWithKey (fst <$> addResults) $ \(dimIx, miCoord) -> \case
+    let addForm :: MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (Maybe (Map (BoxCoord liveliness) cellData -> FormResult (Map (BoxCoord liveliness) cellData))), Maybe Widget))
-        FormSuccess (Just mkResult)
+        addForm = addForm' boxOrigin [] $ zip [0..] boxDimensions
-          | miAllowAdd miCoord dimIx sentLiveliness -> Just <$> mkResult sentShape'
+          where
+            addForm' _ _ [] = return Map.empty
+            addForm' miCoord pDims (dim''@(dimIx, _) : remDims) = do
+              let nudgeAddWidgetName :: Text -> Text
+                  nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
+              (btnRes', btnView) <- mopt (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..} & addFormAction) Nothing
+              let btnRes = do
+                    Just x <- btnRes'
+                    return x
+                  wBtnRes res = do
+                    guard $ isn't _FormMissing btnRes
+                    res
+                  miAdd' = traverse ($ mempty) $ miAdd miCoord dimIx sentLiveliness' nudgeAddWidgetName btnView
+              addRes'' <- miAdd' <&> (_Just . _1) %~ wBtnRes
+              addRes' <- fmap join . for addRes'' $ bool (return . Just) (\(res, _view) -> set (_Just . _1) res <$> local (set _1 Nothing) miAdd') (is (_Just . _FormSuccess) (fst <$> addRes'') || is _FormMissing btnRes)
+              let dimRes' = Map.singleton (dimIx, miCoord) (maybe (Nothing <$ btnRes) (fmap Just . fst) addRes', fmap snd addRes')
+              case remDims of
+                [] -> return dimRes'
+                ((_, BoxDimension dim) : _) -> do
+                  let miCoords
+                        = Set.union (miAddEmpty miCoord dimIx sentLiveliness')
+                        . Set.map (\c -> miCoord & dim .~ (c ^. dim))
+                        . Set.filter (\c -> and [ ((==) `on` view pDim) miCoord c | (_, BoxDimension pDim) <- pDims `snoc` dim'' ])
+                        $ review liveCoords sentLiveliness'
+                  dimRess <- sequence $ Map.fromSet (\c -> addForm' c (pDims `snoc` dim'') remDims) miCoords
+                  return $ dimRes' `Map.union` fold dimRess
+
+    addResults <- replaceWithFirst (view _4 <$> mPrev) <$> addForm
+    let
+      addResults' :: Map (Natural, BoxCoord liveliness) (FormResult (Maybe (Map (BoxCoord liveliness) cellData)))
+      addResults' = fmap (view _1) addResults <&> \case
+        FormSuccess (Just mkShape) -> Just <$> mkShape sentShape'
         other -> Nothing <$ other
-  let addShape
+    let addShape
-        | [((dimIx, miCoord), FormSuccess (Just mkResult))] <- Map.toList . Map.filter (is $ _FormSuccess . _Just) $ fmap fst addResults
+          | [FormSuccess (Just mkResult)] <- Map.elems . Map.filter (is $ _FormSuccess . _Just) $ view _1 <$> addResults
-        = Just $ maybe id Map.union (formResultToMaybe $ mkResult sentShape' <* guard (miAllowAdd miCoord dimIx sentLiveliness)) sentShape'
+          = Just $ maybe id Map.union (formResultToMaybe $ mkResult sentShape') sentShape'
-        | otherwise = Nothing
+          | otherwise = Nothing
 
-  addedShape <- if
+    addedShape <- if
-    | Just s <- addShape -> return s
+      | Just s <- addShape -> return s
-    | otherwise -> return sentShape'
+      | otherwise -> return sentShape'
 
-  let
+    let
-    delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
+      delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
-    delForm miCoord = do
+      delForm miCoord = do
-      (delRes, delView) <- lift $ mopt (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..} & addFormAction) Nothing
+        (delRes, delView) <- lift $ mopt (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..} & addFormAction) Nothing
-      shapeUpdate <- miDelete addedShape miCoord
+        shapeUpdate <- miDelete addedShape miCoord
-      guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
+        guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
-      return (shapeUpdate <$ assertM (is _Just) delRes, delView)
+        return (shapeUpdate <$ assertM (is _Just) delRes, delView)
 
-  delResults <- fmap (Map.mapMaybe id) . sequence $ Map.fromSet (runMaybeT . delForm) (Map.keysSet addedShape)
+    delResults <- fmap (replaceWithFirst (view _6 <$> mPrev) . Map.mapMaybe id) . sequence $ Map.fromSet (runMaybeT . delForm) (Map.keysSet addedShape)
-  let
+    let
-    delShapeUpdate
+      delShapeUpdate
-        | [FormSuccess shapeUpdate'] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst delResults = Just shapeUpdate'
+          | [FormSuccess shapeUpdate'] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst delResults = Just shapeUpdate'
-        | otherwise = Nothing
+          | otherwise = Nothing
-    delShape = traverse (`Map.lookup` addedShape) =<< delShapeUpdate
+      delShape = traverse (`Map.lookup` addedShape) =<< delShapeUpdate
 
 
-  let shapeChanged = Fold.any (isn't _FormMissing . view _1) addResults || Fold.any (is _FormSuccess . view _1) delResults
+    let shapeChanged = Fold.any (hasn't $ _1 . _FormMissing) addResults || Fold.any (has $ _1 . _FormSuccess) delResults
 
-  shape <- if
+    shape <- if
-    | Just s <- addShape -> return s
+      | Just s <- addShape -> return s
-    | Just s <- delShape -> return s
+      | Just s <- delShape -> return s
-    | otherwise          -> return sentShape'
+      | otherwise          -> return sentShape'
-  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
+    liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
+
+    return (shape, liveliness, delShapeUpdate, addResults, addResults', delResults, shapeChanged)
 
   shapeId <- newIdent
   let shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True
@@ -424,7 +438,7 @@ massInput MassInput{ miIdent = toPathPiece -> miIdent, ..} FieldSettings{..} fvR
           (fmap (view _1 &&& view (_2 . _1)) cellResults)
           (fmap (view $ _2 . _2) cellResults)
           (fmap (view _2) delResults)
-          (Map.mapMaybeWithKey (\(dimIx, miCoord) (_, wdgt) -> wdgt <* guard (miAllowAdd miCoord dimIx liveliness)) addResults)
+          (Map.mapMaybe (view _2) addResults)
 
   MsgRenderer mr <- getMsgRenderer
 
@@ -489,12 +503,11 @@ massInputList :: forall handler cellResult ident msg.
               -> Maybe [cellResult]
               -> (Markup -> MForm handler (FormResult [cellResult], FieldView UniWorX))
 massInputList field fieldSettings onMissing miButtonAction miIdent miSettings miRequired miPrevResult = over (mapped . _1 . mapped) (map snd . Map.elems) . massInput
-  MassInput { miAdd = \_ _ _ submitBtn -> Just $ \csrf ->
+  MassInput { miAdd = \_ _ _ _ submitBtn -> Just $ \csrf ->
                 return (FormSuccess $ \pRes -> FormSuccess $ Map.singleton (maybe 0 (succ . fst) $ Map.lookupMax pRes) (), toWidget csrf >> fvWidget submitBtn)
             , miCell = \pos () iRes nudge csrf ->
                 over _2 (\fv -> $(widgetFile "widgets/massinput/list/cell")) <$> mreqMsg field (fieldSettings pos & addName (nudge "field")) onMissing iRes
             , miDelete = miDeleteList
-            , miAllowAdd = \_ _ _ -> True
             , miAddEmpty = \_ _ _ -> Set.empty
             , miButtonAction
             , miLayout = listMiLayout
@@ -541,10 +554,10 @@ massInputAccum :: forall handler cellData ident.
 massInputAccum miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequired mPrev csrf
   = over (_1 . mapped) (map fst . Map.elems) <$> massInput MassInput{..} fSettings fRequired (Map.fromList . zip [0..] . map (, ()) <$> mPrev) csrf
   where
-    miAdd :: ListPosition -> Natural
+    miAdd :: ListPosition -> Natural -> ListLength
           -> (Text -> Text) -> FieldView UniWorX
           -> Maybe (Markup -> MForm handler (FormResult (Map ListPosition cellData -> FormResult (Map ListPosition cellData)), Widget))
-    miAdd _pos _dim nudge submitView = Just (fmap (over (_1 . mapped) doAdd) . miAdd' nudge submitView)
+    miAdd _pos _dim _liveliness nudge submitView = Just (fmap (over (_1 . mapped) doAdd) . miAdd' nudge submitView)
 
     doAdd :: ([cellData] -> FormResult [cellData]) -> (Map ListPosition cellData -> FormResult (Map ListPosition cellData))
     doAdd f prevData = Map.fromList . zip [startKey..] <$> f prevElems
@@ -559,8 +572,6 @@ massInputAccum miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequire
     miDelete :: MassInputDelete ListLength
     miDelete = miDeleteList
 
-    miAllowAdd _ _ _ = True
-
     miAddEmpty _ _ _ = Set.empty
 
 massInputAccumA :: forall handler cellData ident.
@@ -619,10 +630,10 @@ massInputAccumEdit :: forall handler cellData ident.
 massInputAccumEdit miAdd' miCell' miButtonAction miLayout miIdent fSettings fRequired mPrev csrf
   = over (_1 . mapped) (map snd . Map.elems) <$> massInput MassInput{..} fSettings fRequired (Map.fromList . zip [0..] . map (\x -> (x, x)) <$> mPrev) csrf
   where
-    miAdd :: ListPosition -> Natural
+    miAdd :: ListPosition -> Natural -> ListLength
           -> (Text -> Text) -> FieldView UniWorX
           -> Maybe (Markup -> MForm handler (FormResult (Map ListPosition cellData -> FormResult (Map ListPosition cellData)), Widget))
-    miAdd _pos _dim nudge submitView = Just (fmap (over (_1 . mapped) doAdd) . miAdd' nudge submitView)
+    miAdd _pos _dim _liveliness nudge submitView = Just (fmap (over (_1 . mapped) doAdd) . miAdd' nudge submitView)
 
     doAdd :: ([cellData] -> FormResult [cellData]) -> (Map ListPosition cellData -> FormResult (Map ListPosition cellData))
     doAdd f prevData = Map.fromList . zip [startKey..] <$> f prevElems
@@ -632,13 +643,11 @@ massInputAccumEdit miAdd' miCell' miButtonAction miLayout miIdent fSettings fReq
 
     miCell :: ListPosition -> cellData -> Maybe cellData -> (Text -> Text)
            -> (Markup -> MForm handler (FormResult cellData, Widget))
-    miCell _pos dat _mPrev nudge = miCell' nudge dat
+    miCell _pos dat mPrev' nudge = miCell' nudge $ fromMaybe dat mPrev'
 
     miDelete :: MassInputDelete ListLength
     miDelete = miDeleteList
 
-    miAllowAdd _ _ _ = True
-
     miAddEmpty _ _ _ = Set.empty
 
 massInputAccumEditA :: forall handler cellData ident.

src/Handler/Utils/I18n.hs

@@ -30,7 +30,7 @@ i18nFile includeFile basename = do
   -- Construct list of available translations (@de@, @en@, ...) at compile time
   let i18nDirectory = "templates" </> "i18n" </> basename
   availableFiles <- qRunIO $ listDirectory i18nDirectory
-  let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . List.nub $ pack . takeBaseName <$> availableFiles
+  let availableTranslations = sortWith (NTop . flip List.elemIndex (NonEmpty.toList appLanguages)) . nubOrd $ pack . takeBaseName <$> availableFiles
   availableTranslations' <- maybe (fail $ "‘" <> i18nDirectory <> "’ is empty") return $ NonEmpty.nonEmpty availableTranslations
 
   -- Dispatch to correct language (depending on user settings via `selectLanguage`) at run time

src/Handler/Utils/Invitations.hs

@@ -323,7 +323,7 @@ deleteInvitationsF :: forall junction m mono backend.
                    -> ReaderT backend m ()
 -- | Non-conduit version of `deleteInvitations`
 deleteInvitationsF invitationFor (otoList -> emailList)
-  = deleteWhere [InvitationEmail <-. nub emailList, InvitationFor ==. invRef @junction invitationFor]
+  = deleteWhere [InvitationEmail <-. nubOrd emailList, InvitationFor ==. invRef @junction invitationFor]
 
 deleteInvitation :: forall junction m backend.
                     ( IsInvitableJunction junction

src/Handler/Utils/Memcached.hs

@@ -356,7 +356,8 @@ memcached :: ( MonadHandler m, HandlerSite m ~ UniWorX
           => Maybe Expiry -> m a -> m a
 memcached mExp = memcachedWith (memcachedGet, \x -> x <$ memcachedSet mExp x)
 
-memcachedBy :: ( MonadHandler m, HandlerSite m ~ UniWorX
+memcachedBy :: forall a m k.
+               ( MonadHandler m, HandlerSite m ~ UniWorX
                , MonadThrow m
                , Typeable a, Binary a, NFData a
                , Binary k
@@ -550,7 +551,7 @@ memcacheAuth k mx = cachedByBinary k $ do
      | otherwise
        -> evalWriterT mx
 
-memcacheAuth' :: forall m k a.
+memcacheAuth' :: forall a m k.
                  ( MonadHandler m, HandlerSite m ~ UniWorX
                  , MonadThrow m
                  , Typeable a, Binary a, NFData a

src/Handler/Utils/Submission.hs

@@ -362,7 +362,7 @@ submissionMultiArchive anonymous sft (Set.toList -> ids) = do
                     E.where_ $ submission E.^. SubmissionId E.==. E.val submissionID
                     E.where_ $ sheet E.^. SheetCourse E.==. submissionGroup E.^. SubmissionGroupCourse
                   return $ submissionGroup E.^. SubmissionGroupName
-                let asciiGroups = nub . sort $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) groups
+                let asciiGroups = Set.toList . Set.fromList $ map (filter isAlphaNum . foldMap unidecode . unpack . CI.original . E.unValue) groups
                 return . intercalate "_" $ asciiGroups `snoc` fp
             | Just feature <- userFeature anonymous
             = do
@@ -453,7 +453,9 @@ extractRatingsMsg = do
           (Right $(widgetFile "messages/submissionFilesIgnored"))
     addMessageWidget Warning ignoredModal
 
--- | Nicht innerhalb von runDB aufrufen, damit das DB Rollback passieren kann!
+-- | Needs to *not* be called from within `runDB` so db transaction rollback can happen properly
+--
+-- Nontheless: we do assume elsewhere, that we can call `msgSubmissionErrors` from within `runDB` as long as we do `transactionUndo` iff it returns `Nothing`.
 msgSubmissionErrors :: (MonadHandler m, MonadCatch m, HandlerSite m ~ UniWorX) => m a -> m (Maybe a)
 msgSubmissionErrors = flip catches
     [ E.Handler $ \e -> Nothing <$ addMessageI Error (e :: SubmissionSinkException)

src/Handler/Utils/TermCandidates.hs

@@ -18,7 +18,6 @@ import Import
 -- import Control.Monad.Trans.Writer (mapWriterT)
 -- import Database.Persist.Sql (fromSqlKey)
 import qualified Data.Set as Set
-import qualified Data.List as List
 import qualified Data.Map as Map
 
 
@@ -112,7 +111,7 @@ removeAmbiguousNames = do
               )
     E.having $ E.countRows E.!=. E.val (1 :: Int64)
     return $ candidate E.^. StudyTermNameCandidateIncidence
-  let ambiSet = E.unValue <$> List.nub ambiList
+  let ambiSet = E.unValue <$> nubOrd ambiList
   -- Most SQL dialects won't allow deletion and queries on the same table at once, hence we delete in two steps.
   deleteWhere [StudyTermNameCandidateIncidence <-. ambiSet]
   return ambiSet

src/Handler/Utils/Users.hs

@@ -24,6 +24,7 @@ import qualified Data.Aeson as JSON
 import qualified Data.Aeson.Types as JSON
 
 import qualified Data.Set as Set
+import qualified Data.List as List
 import qualified Data.CaseInsensitive as CI
 
 import qualified Database.Esqueleto.Legacy as E
@@ -200,6 +201,7 @@ data UserAssimilateExceptionReason
   | UserAssimilateExamResultDifferentResult (Entity ExamResult) (Entity ExamResult)
   | UserAssimilatePersonalisedSheetFileDifferentContent (Entity PersonalisedSheetFile) (Entity PersonalisedSheetFile)
   | UserAssimilateTutorialParticipantCollidingRegGroups (Entity TutorialParticipant) (Entity TutorialParticipant)
+  | UserAssimilateCouldNotDetermineUserIdents
   deriving (Eq, Ord, Show, Generic, Typeable)
 
 assimilateUser :: UserId -- ^ @newUserId@
@@ -773,6 +775,17 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
             delete oldSFId
    in runConduit $ getStudyFeatures .| C.mapM_ upsertStudyFeatures
 
+  userIdents <- E.select . E.from $ \user -> do
+    E.where_ $ user E.^. UserId `E.in_` E.valList [newUserId, oldUserId]
+    return ( user E.^. UserId
+           , user E.^. UserIdent
+           )
+  case (,) <$> List.lookup (E.Value oldUserId) userIdents <*> List.lookup (E.Value newUserId) userIdents of
+    Just (E.Value oldIdent, E.Value newIdent')
+      | oldIdent /= newIdent' -> audit $ TransactionUserIdentChanged oldIdent newIdent'
+      | otherwise -> return ()
+    _other -> tellError UserAssimilateCouldNotDetermineUserIdents
+
   delete oldUserId
   audit $ TransactionUserAssimilated newUserId oldUserId
   where

src/Handler/Utils/Widgets.hs

@@ -31,12 +31,19 @@ visibleUTCTime dtf t = do
 
 
 -- | Simple link to a known route
-simpleLink :: RedirectUrl UniWorX url => Widget -> url -> Widget
+simpleLink :: HasRoute UniWorX url => Widget -> url -> Widget
 simpleLink lbl url = do
-  tUrl <- toTextUrl url
+  isAuth <- hasReadAccessTo $ urlRoute url
-  [whamlet|<a href=#{tUrl}>^{lbl}|]
+  if | isAuth -> do
+         tUrl <- toTextUrl url
+         [whamlet|
+           $newline never
+           <a href=#{tUrl}>
+             ^{lbl}
+           |]
+     | otherwise -> lbl
 
-simpleLinkI :: (RenderMessage UniWorX msg, RedirectUrl UniWorX url) => msg -> url -> Widget
+simpleLinkI :: (RenderMessage UniWorX msg, HasRoute UniWorX url) => msg -> url -> Widget
 simpleLinkI = simpleLink . i18n
 
 -- | toWidget-Version of @nameHtml@, for convenience
@@ -97,6 +104,10 @@ editedByW fmt tm usr  = do
   ft <- handlerToWidget $ formatTime fmt tm
   [whamlet|_{MsgUtilEditedBy usr ft}|]
 
+boolHeat :: Bool -- ^ @isHot@
+         -> Milli
+boolHeat = bool 0 1
+
 heat :: ( Real a, Real b )
      => a -> b -> Milli
 -- ^ Distinguishes @full@, zero is mapped to 1, @full@ is mapped to 0

src/Handler/Utils/Workflow.hs

@@ -0,0 +1,29 @@
+module Handler.Utils.Workflow
+  ( workflowsDisabledWarning
+  , module Reexport
+  ) where
+
+import Import
+
+import Handler.Utils.I18n
+
+import Handler.Utils.Workflow.Form as Reexport
+import Handler.Utils.Workflow.EdgeForm as Reexport
+import Handler.Utils.Workflow.Restriction as Reexport
+import Handler.Utils.Workflow.CanonicalRoute as Reexport
+import Handler.Utils.Workflow.Workflow as Reexport
+
+
+workflowsDisabledWarning :: ( MonadHandler m
+                            , HandlerSite m ~ UniWorX
+                            , RenderMessage UniWorX titleMsg, RenderMessage UniWorX headingMsg
+                            )
+                         => titleMsg -> headingMsg
+                         -> m Html
+                         -> m Html
+workflowsDisabledWarning tMsg hMsg = volatileBool clusterVolatileWorkflowsEnabled warningHtml
+  where
+    warningHtml = liftHandler . siteLayoutMsg hMsg $ do
+      setTitleI tMsg
+
+      notificationWidget NotificationBroad Warning $(i18nWidgetFile "workflows-disabled")

src/Handler/Utils/Workflow/CanonicalRoute.hs

@@ -16,7 +16,7 @@ data WorkflowScopeRoute
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 data WorkflowInstanceR
-  = WIEditR | WIDeleteR | WIWorkflowsR | WIInitiateR
+  = WIEditR | WIDeleteR | WIWorkflowsR | WIInitiateR | WIUpdateR
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 data WorkflowWorkflowR
@@ -36,6 +36,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute
           WIDeleteR    -> GWIDeleteR
           WIWorkflowsR -> GWIWorkflowsR
           WIInitiateR  -> GWIInitiateR
+          WIUpdateR    -> GWIUpdateR
         WorkflowWorkflowListR            -> GlobalWorkflowWorkflowListR
         WorkflowWorkflowR wwCID subRoute -> GlobalWorkflowWorkflowR wwCID $ case subRoute of
           WWWorkflowR        -> GWWWorkflowR
@@ -50,6 +51,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute
           WIDeleteR    -> SWIDeleteR
           WIWorkflowsR -> SWIWorkflowsR
           WIInitiateR  -> SWIInitiateR
+          WIUpdateR    -> SWIUpdateR
         WorkflowWorkflowListR            -> SchoolWorkflowWorkflowListR
         WorkflowWorkflowR wwCID subRoute -> SchoolWorkflowWorkflowR wwCID $ case subRoute of
           WWWorkflowR        -> SWWWorkflowR
@@ -65,6 +67,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute
         GWIDeleteR    -> WIDeleteR
         GWIWorkflowsR -> WIWorkflowsR
         GWIInitiateR  -> WIInitiateR
+        GWIUpdateR    -> WIUpdateR
       GlobalWorkflowWorkflowListR            -> Just ( WSGlobal, WorkflowWorkflowListR )
       GlobalWorkflowWorkflowR wwCID subRoute -> Just . (WSGlobal, ) . WorkflowWorkflowR wwCID $ case subRoute of
         GWWWorkflowR        -> WWWorkflowR
@@ -79,6 +82,7 @@ _WorkflowScopeRoute = prism' (uncurry toRoute) toWorkflowScopeRoute
           SWIDeleteR    -> WIDeleteR
           SWIWorkflowsR -> WIWorkflowsR
           SWIInitiateR  -> WIInitiateR
+          SWIUpdateR    -> WIUpdateR
         SchoolWorkflowWorkflowListR            -> Just ( WSSchool ssh, WorkflowWorkflowListR )
         SchoolWorkflowWorkflowR wwCID subRoute -> Just . (WSSchool ssh, ) . WorkflowWorkflowR wwCID $ case subRoute of
           SWWWorkflowR        -> WWWorkflowR

src/Handler/Utils/Workflow/EdgeForm.hs

@@ -527,10 +527,11 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec
 
                 miAdd :: ListPosition
                       -> Natural
+                      -> ListLength
                       -> (Text -> Text)
                       -> FieldView UniWorX
                       -> Maybe (Html -> MForm (ExceptT WorkflowPayloadLabel Handler) (FormResult (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId)) -> FormResult (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId)))), Widget))
-                miAdd _pos _dim nudge submitView = Just $ over (mapped . _1 . _FormSuccess) tweakRes . miForm nudge (Left submitView)
+                miAdd pos dim liveliness nudge submitView = guardOn (miAllowAdd pos dim liveliness) $ over (mapped . _1 . _FormSuccess) tweakRes . miForm nudge (Left submitView)
                   where tweakRes :: Maybe (NonEmpty (WorkflowFieldPayloadW FileReference UserId))
                                  -> Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId))
                                  -> FormResult (Map ListPosition (Maybe (WorkflowFieldPayloadW FileReference UserId)))

src/Handler/Utils/Workflow/Workflow.hs

@@ -70,7 +70,7 @@ followAutomaticEdges WorkflowGraph{..} = go []
       | otherwise = throwM . WorkflowAutomaticEdgeAmbiguity $ Set.fromList automaticEdgeOptions
       where
         cState = wpTo $ last history
-        automaticEdgeOptions = nub $ do
+        automaticEdgeOptions = nubOrd $ do
           (nodeLbl, WGN{..}) <- Map.toList wgNodes
           (edgeLbl, WorkflowGraphEdgeAutomatic{..}) <- Map.toList wgnEdges
           guard $ wgeSource == cState