From c2df01c2f710eef3ec8ba8bd0a745f393169832c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 13 Aug 2019 11:30:45 +0200
Subject: [PATCH 1/7] feat(allocations): set up routes

---
 messages/uniworx/de.msg           |   3 +
 models/allocations                |   9 +--
 routes                            |   6 ++
 src/Application.hs                |   1 +
 src/CryptoID.hs                   |   1 +
 src/Data/CryptoID/Instances.hs    |  20 +++++-
 src/Data/Void/Instances.hs        |  12 ++++
 src/Foundation.hs                 | 107 ++++++++++++++++++++++++------
 src/Handler/Allocation.hs         |   6 ++
 src/Handler/Allocation/Edit.hs    |  13 ++++
 src/Handler/Allocation/Show.hs    |  15 +++++
 src/Handler/Course/Application.hs |   9 +++
 src/Handler/Course/Register.hs    |  10 ++-
 src/Handler/Course/Show.hs        |   4 ++
 src/Import/NoModel.hs             |   1 +
 src/Model/Migration.hs            |   9 +++
 src/Model/Types/Common.hs         |  42 ++++++------
 src/Model/Types/Security.hs       |   1 +
 templates/course.hamlet           |   6 +-
 test/Database.hs                  |  22 ++++++
 20 files changed, 246 insertions(+), 51 deletions(-)
 create mode 100644 src/Data/Void/Instances.hs
 create mode 100644 src/Handler/Allocation.hs
 create mode 100644 src/Handler/Allocation/Edit.hs
 create mode 100644 src/Handler/Allocation/Show.hs

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 547092e46..d58321527 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -345,6 +345,7 @@ UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut e
 UnauthorizedAdminEscalation: Sie sind nicht Administrator für alle Institute, für die dieser Nutzer Administrator oder Veranstalter ist.
 UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen.
 UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen.
+UnauthorizedAllocationLecturer: Sie sind nicht als Veranstalter für eine Veranstaltung dieser Zentralanmeldung eingetragen.
 UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung eingetragen.
 UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen.
 UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen.
@@ -352,6 +353,7 @@ UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung r
 UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
 UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
 UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
+UnauthorizedAllocationRegisterTime: Diese Zentralanmeldung erlaubt momentan keine Bewerbungen.
 UnauthorizedSheetTime: Dieses Übungsblatt ist momentan nicht freigegeben.
 UnauthorizedApplicationTime: Diese Bewerbung ist momentan nicht freigegeben.
 UnauthorizedMaterialTime: Dieses Material ist momentan nicht freigegeben.
@@ -1014,6 +1016,7 @@ AuthTagLecturer: Nutzer ist Dozent
 AuthTagCorrector: Nutzer ist Korrektor
 AuthTagTutor: Nutzer ist Tutor
 AuthTagTime: Zeitliche Einschränkungen sind erfüllt
+AuthTagStaffTime: Zeitliche Einschränkungen für Lehrbeteiligte sind erfüllt
 AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind erfüllt
 AuthTagCourseRegistered: Nutzer ist Kursteilnehmer
 AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
diff --git a/models/allocations b/models/allocations
index f7522696f..0fac2cfee 100644
--- a/models/allocations
+++ b/models/allocations
@@ -1,12 +1,10 @@
 Allocation -- attributes with prefix staff- affect lecturers only, but are invisble to students
-    name                (CI Text)
-    shorthand           (CI Text)       -- practical shorthand
+    name                AllocationName
+    shorthand           AllocationShorthand -- practical shorthand
     term                TermId
     school              SchoolId        -- school that manages this central allocation, not necessarily school of courses
     description         Html Maybe      -- description for prospective students
     staffDescription    Html Maybe      -- description seen by prospective lecturers only
-    linkExternal        Text Maybe      -- arbitrary user-defined url for external course page
-    capacity            Int Maybe       -- number of allowed enrolements, if restricte
     staffRegisterFrom   UTCTime Maybe   -- lectureres may register courses
     staffRegisterTo     UTCTime Maybe   -- course registration stops
     -- staffDeregisterUntil not needed: staff may make arbitrary changes until staffRegisterTo, always frozen afterwards
@@ -17,7 +15,6 @@ Allocation -- attributes with prefix staff- affect lecturers only, but are invis
     registerFrom        UTCTime Maybe   -- student applications allowed from a given day onwwards or prohibited
     registerTo          UTCTime Maybe   -- student applications may be prohibited from a given date onwards
     -- deregisterUntil not needed: students may withdraw applicants until registerTo, but never after. Also see overrideDeregister
-    registerSecret      Text Maybe      -- student application maybe protected by a simple common passphrase
     -- overrides
     registerByStaffFrom UTCTime Maybe   -- lecturers may directly enrol/disenrol students after a given date or prohibited
     registerByStaffTo   UTCTime Maybe
@@ -26,6 +23,7 @@ Allocation -- attributes with prefix staff- affect lecturers only, but are invis
     -- overrideVisible not needed, since courses are always visible
     TermSchoolAllocationShort  term school shorthand    -- shorthand must be unique within school and semester
     TermSchoolAllocationName   term school name         -- name must be unique within school and semester
+    deriving Show
 
 AllocationCourse
     allocation          AllocationId
@@ -41,7 +39,6 @@ AllocationUser
 
 AllocationDeregister -- self-inflicted user-deregistrations from an allocated course
     user                UserId
-    allocation          AllocationId Maybe
     course              CourseId Maybe
     time                UTCTime
     reason              Text Maybe -- if this deregistration was done by proxy (e.g. the lecturer pressed the button)
diff --git a/routes b/routes
index 54f0fc5c5..d8cbe8260 100644
--- a/routes
+++ b/routes
@@ -80,6 +80,11 @@
 /school                    SchoolListR         GET             !development
 /school/#SchoolId          SchoolShowR         GET             !development
 
+/allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
+  /                                              AShowR   GET             !free
+  /course/#CryptoUUIDCourse/apply                AApplyR      POST        !time
+  /application/#CryptoFileNameCourseApplication  AEditR   GET POST        !timeANDself !lecturerANDstaff-time
+
 
 -- For Pattern Synonyms see Foundation
 /course/                    CourseListR        GET             !free
@@ -154,6 +159,7 @@
     /users/new                  EAddUserR      GET POST
     /users/invite               EInviteR       GET POST
     /register                   ERegisterR         POST        !timeANDcourse-registeredAND¬exam-registered !timeANDexam-registeredAND¬exam-result
+  /apps                         CApplicationsR GET POST
   /apps/#CryptoFileNameCourseApplication CourseApplicationR:
     /files                      CAFilesR       GET             !self !lecturerANDtime
 
diff --git a/src/Application.hs b/src/Application.hs
index 7291fda1c..597a316fd 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -112,6 +112,7 @@ import Handler.CryptoIDDispatch
 import Handler.SystemMessage
 import Handler.Health
 import Handler.Exam
+import Handler.Allocation
 
 
 -- This line actually creates our YesodDispatch instance. It is the second half
diff --git a/src/CryptoID.hs b/src/CryptoID.hs
index 915ad5de0..9263ca308 100644
--- a/src/CryptoID.hs
+++ b/src/CryptoID.hs
@@ -49,6 +49,7 @@ decCryptoIDs [ ''SubmissionId
              , ''ExamPartId
              , ''AllocationId
              , ''CourseApplicationId
+             , ''CourseId
              ]
 
 -- CryptoIDNamespace (CI FilePath) SubmissionId ~ "Submission"
diff --git a/src/Data/CryptoID/Instances.hs b/src/Data/CryptoID/Instances.hs
index 3e842dd6a..bc66cb874 100644
--- a/src/Data/CryptoID/Instances.hs
+++ b/src/Data/CryptoID/Instances.hs
@@ -13,8 +13,24 @@ import ClassyPrelude
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
-instance {-# OVERLAPS #-} ToMarkup s => ToMarkup (CID.CryptoID c (CI s)) where
-  toMarkup = toMarkup . CI.foldedCase . CID.ciphertext
+import Web.PathPieces
+import Data.Aeson (ToJSON(..), ToJSONKey(..), ToJSONKeyFunction(..))
+
 
 instance ToMarkup s => ToMarkup (CID.CryptoID c s) where
   toMarkup = toMarkup . CID.ciphertext
+
+instance {-# OVERLAPS #-} ToMarkup s => ToMarkup (CID.CryptoID c (CI s)) where
+  toMarkup = toMarkup . CI.foldedCase . CID.ciphertext
+
+instance {-# OVERLAPS #-} ToJSON s => ToJSON (CID.CryptoID c (CI s)) where
+  toJSON = toJSON . CI.foldedCase . CID.ciphertext
+
+instance {-# OVERLAPS #-} (ToJSON s, ToJSONKey s) => ToJSONKey (CID.CryptoID c (CI s)) where
+  toJSONKey = case toJSONKey of
+    ToJSONKeyText toT toE -> ToJSONKeyText (toT . CI.foldedCase . CID.ciphertext) (toE . CI.foldedCase . CID.ciphertext)
+    ToJSONKeyValue toV toE -> ToJSONKeyValue (toV . CI.foldedCase . CID.ciphertext) (toE . CI.foldedCase . CID.ciphertext)
+
+instance {-# OVERLAPS #-} (PathPiece s, CI.FoldCase s) => PathPiece (CID.CryptoID c (CI s)) where
+  toPathPiece = toPathPiece . CI.foldedCase . CID.ciphertext
+  fromPathPiece = fmap (CID.CryptoID . CI.mk) . fromPathPiece
diff --git a/src/Data/Void/Instances.hs b/src/Data/Void/Instances.hs
new file mode 100644
index 000000000..a59e0cd39
--- /dev/null
+++ b/src/Data/Void/Instances.hs
@@ -0,0 +1,12 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Data.Void.Instances
+  (
+  ) where
+
+import ClassyPrelude.Yesod
+import Data.Void
+
+instance ToContent Void where
+  toContent = absurd
+instance ToTypedContent Void where
+  toTypedContent = absurd
diff --git a/src/Foundation.hs b/src/Foundation.hs
index d1e2e9892..3cfa94442 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -600,6 +600,17 @@ tagAccessPredicate AuthAdmin = APDB $ \mAuthId route _ -> case route of
             E.&&. course E.^. CourseShorthand E.==. E.val csh
     guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
     return Authorized
+  -- Allocations: access only to school admins
+  AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    isAdmin <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` userAdmin) -> do
+      E.on $ allocation E.^. AllocationSchool E.==. userAdmin E.^. UserAdminSchool
+      E.where_  $ userAdmin E.^. UserAdminUser E.==. E.val authId
+            E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
+            E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
+            E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
+    guardMExceptT isAdmin (unauthorizedI MsgUnauthorizedSchoolAdmin)
+    return Authorized
   -- other routes: access to any admin is granted here
   _other -> $cachedHereBinary mAuthId . exceptT return return $ do
     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
@@ -641,6 +652,34 @@ tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
             E.&&. course E.^. CourseShorthand E.==. E.val csh
      guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
      return Authorized
+  AllocationR tid ssh ash (AEditR cID) -> $cachedHereBinary (mAuthId, tid, ssh, ash, cID) . exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    appId <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedLecturer) (const True :: CryptoIDError -> Bool) $ decrypt cID
+    isLecturer <- lift . E.selectExists . E.from $ \(courseApplication `E.InnerJoin` allocation `E.InnerJoin` allocationCourse `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
+      E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+      E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
+      E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
+      E.on $ courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocation E.^. AllocationId)
+       E.&&. courseApplication E.^. CourseApplicationCourse E.==. course E.^. CourseId
+      E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
+           E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
+           E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
+           E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
+           E.&&. courseApplication E.^. CourseApplicationId E.==. E.val appId
+    guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
+    return Authorized
+  AllocationR tid ssh ash _ -> $cachedHereBinary (mAuthId, tid, ssh, ash) . exceptT return return $ do
+    authId <- maybeExceptT AuthenticationRequired $ return mAuthId
+    isLecturer <- lift . E.selectExists . E.from $ \(allocation `E.InnerJoin` allocationCourse `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
+      E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
+      E.on $ course E.^. CourseId E.==. allocationCourse E.^. AllocationCourseCourse
+      E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
+      E.where_ $ lecturer E.^. LecturerUser E.==. E.val authId
+           E.&&. allocation E.^. AllocationTerm      E.==. E.val tid
+           E.&&. allocation E.^. AllocationSchool    E.==. E.val ssh
+           E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
+    guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedAllocationLecturer)
+    return Authorized
   -- lecturer for any school will do
   _ -> $cachedHereBinary mAuthId . exceptT return return $ do
      authId <- maybeExceptT AuthenticationRequired $ return mAuthId
@@ -712,8 +751,6 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
 
     return Authorized
         
-    
-  
   CExamR tid ssh csh examn subRoute -> maybeT (unauthorizedI MsgUnauthorizedExamTime) $ do
     course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
     Entity eId Exam{..} <- $cachedHereBinary (course, examn) . MaybeT . getBy $ UniqueExam course examn
@@ -823,8 +860,16 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
             return Authorized
       _other -> unauthorizedI MsgUnauthorizedCourseTime
 
+  AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
+    -- Checks `registerFrom` and `registerTo`, override as further routes become available
+    now <- liftIO getCurrentTime
+    Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash 
+    guard $ NTop allocationRegisterFrom <= NTop (Just now)
+    guard $ NTop (Just now) <= NTop allocationRegisterTo
+    return Authorized
+
   MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageTime) $ do
-    smId <- decrypt cID
+    smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
     SystemMessage{systemMessageFrom, systemMessageTo} <- $cachedHereBinary smId . MaybeT $ get smId
     cTime <- (NTop . Just) <$> liftIO getCurrentTime
     guard $ NTop systemMessageFrom <= cTime
@@ -832,6 +877,16 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
     return Authorized
 
   r -> $unsupportedAuthPredicate AuthTime r
+tagAccessPredicate AuthStaffTime = APDB $ \_ route _ -> case route of
+  AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
+    -- Checks `registerFrom` and `registerTo`, override as further routes become available
+    now <- liftIO getCurrentTime
+    Entity _ Allocation{..} <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getBy $ TermSchoolAllocationShort tid ssh ash 
+    guard $ NTop allocationStaffAllocationFrom <= NTop (Just now)
+    guard $ NTop (Just now) <= NTop allocationStaffAllocationTo
+    return Authorized
+
+  r -> $unsupportedAuthPredicate AuthStaffTime r
 tagAccessPredicate AuthAllocationTime = APDB $ \mAuthId route _ -> case route of
   CourseR tid ssh csh CRegisterR -> do
     now <- liftIO getCurrentTime
@@ -974,7 +1029,7 @@ tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
     let authorizedIfExists f = do
           [E.Value ok] <- lift . E.select . return . E.exists $ E.from f
           whenExceptT ok Authorized
-    participant <- decrypt cID
+    participant <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedParticipant) (const True :: CryptoIDError -> Bool) $ decrypt cID
     -- participant is currently registered
     $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` courseParticipant) -> do
       E.on $ course E.^. CourseId E.==. courseParticipant E.^. CourseParticipantCourse
@@ -1030,6 +1085,13 @@ tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
            E.&&. course E.^. CourseTerm      E.==. E.val tid
            E.&&. course E.^. CourseSchool    E.==. E.val ssh
            E.&&. course E.^. CourseShorthand E.==. E.val csh
+    -- participant is applicant for this course
+    $cachedHereBinary (participant, tid, ssh, csh) . authorizedIfExists $ \(course `E.InnerJoin` courseApplication) -> do
+      E.on $ course E.^. CourseId E.==. courseApplication E.^. CourseApplicationCourse
+      E.where_ $ courseApplication E.^. CourseApplicationUser E.==. E.val participant
+           E.&&. course E.^. CourseTerm      E.==. E.val tid
+           E.&&. course E.^. CourseSchool    E.==. E.val ssh
+           E.&&. course E.^. CourseShorthand E.==. E.val csh
     unauthorizedI MsgUnauthorizedParticipant
   r -> $unsupportedAuthPredicate AuthParticipant r
 tagAccessPredicate AuthCapacity = APDB $ \_ route _ -> case route of
@@ -1105,20 +1167,21 @@ tagAccessPredicate AuthCorrectorSubmissions = APDB $ \_ route _ -> case route of
     return Authorized
   r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
 tagAccessPredicate AuthSelf = APDB $ \mAuthId route _ -> exceptT return return $ do
-  referencedUser <- case route of
-    AdminUserR cID -> decrypt cID
-    AdminUserDeleteR cID -> decrypt cID
-    AdminHijackUserR cID -> decrypt cID
-    UserNotificationR cID -> decrypt cID
-    UserPasswordR cID -> decrypt cID
-    CourseR _ _ _ (CUserR cID) -> decrypt cID
+  referencedUser' <- case route of
+    AdminUserR cID -> return $ Left cID
+    AdminUserDeleteR cID -> return $ Left cID
+    AdminHijackUserR cID -> return $ Left cID
+    UserNotificationR cID -> return $ Left cID
+    UserPasswordR cID -> return $ Left cID
+    CourseR _ _ _ (CUserR cID) -> return $ Left cID
     CApplicationR _ _ _ cID _ -> do
-      appId <- decrypt cID
-      application <- $cachedHereBinary appId . lift $ get appId
-      case application of
-        Nothing -> throwError =<< unauthorizedI MsgUnauthorizedSelf
-        Just CourseApplication{..} -> return courseApplicationUser
+      appId <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt cID
+      CourseApplication{..} <- maybeMExceptT (unauthorizedI MsgUnauthorizedSelf) . $cachedHereBinary appId $ get appId
+      return $ Right courseApplicationUser
     _other -> throwError =<< $unsupportedAuthPredicate AuthSelf route
+  referencedUser <- case referencedUser' of
+    Right uid -> return uid
+    Left cID  -> catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt cID
   case mAuthId of
     Just uid
       | uid == referencedUser -> return Authorized
@@ -1133,7 +1196,7 @@ tagAccessPredicate AuthIsLDAP = APDB $ \_ route _ -> exceptT return return $ do
     UserPasswordR cID -> return cID
     CourseR _ _ _ (CUserR cID) -> return cID
     _other -> throwError =<< $unsupportedAuthPredicate AuthIsLDAP route
-  referencedUser' <- decrypt referencedUser
+  referencedUser' <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt referencedUser
   maybeTMExceptT (unauthorizedI MsgUnauthorizedLDAP) $ do
     User{..} <- MaybeT $ get referencedUser'
     guard $ userAuthentication == AuthLDAP
@@ -1147,14 +1210,14 @@ tagAccessPredicate AuthIsPWHash = APDB $ \_ route _ -> exceptT return return $ d
     UserPasswordR cID -> return cID
     CourseR _ _ _ (CUserR cID) -> return cID
     _other -> throwError =<< $unsupportedAuthPredicate AuthIsPWHash route
-  referencedUser' <- decrypt referencedUser
+  referencedUser' <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt referencedUser
   maybeTMExceptT (unauthorizedI MsgUnauthorizedPWHash) $ do
     User{..} <- MaybeT $ get referencedUser'
     guard $ is _AuthPWHash userAuthentication
   return Authorized
 tagAccessPredicate AuthAuthentication = APDB $ \mAuthId route _ -> case route of
   MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageAuth) $ do
-    smId <- decrypt cID
+    smId <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
     SystemMessage{..} <- $cachedHereBinary smId . MaybeT $ get smId
     let isAuthenticated = isJust mAuthId
     guard $ not systemMessageAuthenticatedOnly || isAuthenticated
@@ -1659,6 +1722,12 @@ instance YesodBreadcrumbs UniWorX where
 
   breadcrumb (TermSchoolCourseListR tid ssh)  = return (original $ unSchoolKey ssh, Just $ TermCourseListR tid)
 
+  breadcrumb (AllocationR tid ssh ash AShowR) = do
+    mr <- getMessageRender
+    Entity _ Allocation{allocationName} <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash
+    return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ HomeR)
+  breadcrumb (AllocationR tid ssh ash (AEditR _)) = return ("Bewerbung", Just $ AllocationR tid ssh ash AShowR)
+
   breadcrumb  CourseListR                 = return ("Kurse"    , Nothing)
   breadcrumb  CourseNewR                  = return ("Neu"      , Just CourseListR)
   breadcrumb (CourseR tid ssh csh CShowR) = return (original csh, Just $ TermSchoolCourseListR tid ssh)
diff --git a/src/Handler/Allocation.hs b/src/Handler/Allocation.hs
new file mode 100644
index 000000000..bed822b0d
--- /dev/null
+++ b/src/Handler/Allocation.hs
@@ -0,0 +1,6 @@
+module Handler.Allocation
+  ( module Handler.Allocation
+  ) where
+
+import Handler.Allocation.Show as Handler.Allocation
+import Handler.Allocation.Edit as Handler.Allocation
diff --git a/src/Handler/Allocation/Edit.hs b/src/Handler/Allocation/Edit.hs
new file mode 100644
index 000000000..d9362babb
--- /dev/null
+++ b/src/Handler/Allocation/Edit.hs
@@ -0,0 +1,13 @@
+module Handler.Allocation.Edit
+  ( postAApplyR
+  , getAEditR, postAEditR
+  ) where
+
+import Import
+
+postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
+postAApplyR = fail "Not implemented"
+
+getAEditR, postAEditR :: TermId -> SchoolId -> AllocationShorthand -> CryptoFileNameCourseApplication -> Handler Void
+getAEditR = postAEditR
+postAEditR = fail "Not implemented"
diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs
new file mode 100644
index 000000000..71f1f3967
--- /dev/null
+++ b/src/Handler/Allocation/Show.hs
@@ -0,0 +1,15 @@
+module Handler.Allocation.Show
+  ( getAShowR
+  ) where
+
+import Import
+
+getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
+getAShowR tid ssh ash = do
+  Entity _ alloc <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash
+
+  defaultLayout $ -- TODO
+    [whamlet|
+      <pre>
+        #{tshow alloc}
+    |]
diff --git a/src/Handler/Course/Application.hs b/src/Handler/Course/Application.hs
index 17fa5127b..f4a1fcada 100644
--- a/src/Handler/Course/Application.hs
+++ b/src/Handler/Course/Application.hs
@@ -1,5 +1,6 @@
 module Handler.Course.Application
   ( getCAFilesR
+  , getCApplicationsR, postCApplicationsR
   ) where
 
 import Import
@@ -24,6 +25,10 @@ getCAFilesR tid ssh csh cID = do
           , ssh == courseSchool
           , csh == courseShorthand
           ]
+    forM_ courseApplicationAllocation $ \aId -> do
+      Allocation{..} <- get404 aId
+      cCourse <- encrypt courseApplicationCourse :: DB CryptoUUIDCourse
+      redirectWith movedPermanently301 $ AllocationR courseTerm courseSchool allocationShorthand AShowR :#: toPathPiece cCourse
     unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
     get404 courseApplicationUser
 
@@ -35,3 +40,7 @@ getCAFilesR tid ssh csh cID = do
       return file
 
   serveSomeFiles archiveName $ fsSource .| C.map entityVal
+
+getCApplicationsR, postCApplicationsR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getCApplicationsR = postCApplicationsR
+postCApplicationsR = fail "not implemented" -- dbtable of _all_ course applications
diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs
index 36a82ac97..0d42bba87 100644
--- a/src/Handler/Course/Register.hs
+++ b/src/Handler/Course/Register.hs
@@ -218,8 +218,14 @@ postCRegisterR tid ssh csh = do
           Just _  -> addMessageIconI Success IconEnrolTrue MsgCourseRegisterOk
       BtnCourseDeregister -> runDB $ do
         deleteApplications
-        deleteBy $ UniqueParticipant uid cid
-        audit $ TransactionCourseParticipantDeleted cid uid
+        part <- getBy $ UniqueParticipant uid cid
+        forM_ part $ \(Entity partId CourseParticipant{..}) -> do
+          delete $ partId
+          audit $ TransactionCourseParticipantDeleted cid uid
+
+          when courseParticipantAllocated $ do
+            now <- liftIO getCurrentTime
+            insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing
 
         examRegistrations <- E.select . E.from $ \(examRegistration `E.InnerJoin` exam) -> do
           E.on $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs
index 0eca71463..9bc1b8f53 100644
--- a/src/Handler/Course/Show.hs
+++ b/src/Handler/Course/Show.hs
@@ -79,6 +79,10 @@ getCShowR tid ssh csh = do
   mRegTo   <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo      course
   mDereg   <- traverse (formatTime SelFormatDateTime) $ courseDeregisterUntil course
   mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
+  cID <- encrypt cid :: Handler CryptoUUIDCourse
+  mAllocation' <- for mAllocation $ \Allocation{..} -> (,)
+    <$> pure allocationName
+    <*> toTextUrl (AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: cID)
   regForm <- if
     | is _Just mbAid -> do
         (courseRegisterForm', regButton) <- courseRegisterForm (Entity cid course)
diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs
index 7ec441d58..e9d357662 100644
--- a/src/Import/NoModel.hs
+++ b/src/Import/NoModel.hs
@@ -112,6 +112,7 @@ import Database.Persist.Types.Instances as Import ()
 import Data.UUID.Instances as Import ()
 import System.FilePath.Instances as Import ()
 import Net.IP.Instances as Import ()
+import Data.Void.Instances as Import ()
 
 
 import Control.Monad.Trans.RWS (RWST)
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index 8ad57e8a4..1c9109490 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -445,6 +445,15 @@ customMigrations = Map.fromListWith (>>)
       whenM (tableExists "allocation_application_file") $
         tableDropEmpty "allocation_application_file"
     )
+  , ( AppliedMigrationKey [migrationVersion|17.0.0|] [version|18.0.0|]
+    , do
+        whenM (tableExists "allocation") $ do
+          [executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS capacity;|]
+          [executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS link_external;|]
+          [executeQQ|ALTER TABLE allocation DROP COLUMN IF EXISTS register_secret;|]
+        whenM (tableExists "allocation_deregister") $ do
+          [executeQQ|ALTER TABLE allocation_deregister DROP COLUMN IF EXISTS allocation;|]
+    )
   ]
 
 
diff --git a/src/Model/Types/Common.hs b/src/Model/Types/Common.hs
index 2d8e8b1d0..53ff47cce 100644
--- a/src/Model/Types/Common.hs
+++ b/src/Model/Types/Common.hs
@@ -13,26 +13,28 @@ import Import.NoModel
 import qualified Yesod.Auth.Util.PasswordStore as PWStore
   
 
-type Count  = Sum Integer
-type Points = Centi
+type Count                   = Sum Integer
+type Points                  = Centi
 
-type Email              = Text
+type Email                   = Text
 
-type SchoolName         = CI Text
-type SchoolShorthand    = CI Text
-type CourseName         = CI Text
-type CourseShorthand    = CI Text
-type SheetName          = CI Text
-type MaterialName       = CI Text
-type UserEmail          = CI Email
-type UserIdent          = CI Text
-type TutorialName       = CI Text
-type ExamName           = CI Text
-type ExamPartName       = CI Text
-type ExamOccurrenceName = CI Text
+type SchoolName              = CI Text
+type SchoolShorthand         = CI Text
+type CourseName              = CI Text
+type CourseShorthand         = CI Text
+type SheetName               = CI Text
+type MaterialName            = CI Text
+type UserEmail               = CI Email
+type UserIdent               = CI Text
+type TutorialName            = CI Text
+type ExamName                = CI Text
+type ExamPartName            = CI Text
+type ExamOccurrenceName      = CI Text
+type AllocationName          = CI Text
+type AllocationShorthand     = CI Text
 
-type PWHashAlgorithm = ByteString -> PWStore.Salt -> Int -> ByteString
-type InstanceId      = UUID
-type ClusterId       = UUID
-type TokenId         = UUID
-type TermCandidateIncidence = UUID
+type PWHashAlgorithm         = ByteString -> PWStore.Salt -> Int -> ByteString
+type InstanceId              = UUID
+type ClusterId               = UUID
+type TokenId                 = UUID
+type TermCandidateIncidence  = UUID
diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs
index c18083055..5503f9877 100644
--- a/src/Model/Types/Security.hs
+++ b/src/Model/Types/Security.hs
@@ -48,6 +48,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
   | AuthExamResult
   | AuthParticipant
   | AuthTime
+  | AuthStaffTime
   | AuthAllocationTime
   | AuthMaterials
   | AuthOwner
diff --git a/templates/course.hamlet b/templates/course.hamlet
index 713f61e13..1372fd58d 100644
--- a/templates/course.hamlet
+++ b/templates/course.hamlet
@@ -64,9 +64,11 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
         #{participants}
         $maybe capacity <- courseCapacity course
           \ von #{capacity}
-  $maybe Allocation{allocationName} <- mAllocation
+  $maybe (name, url) <- mAllocation'
     <dt .deflist__dt>_{MsgCourseAllocation}
-    <dd .deflist__dd>#{allocationName}
+    <dd .deflist__dd>
+      <a href=#{url}>
+        #{name}
   $nothing
     $maybe regFrom <- mRegFrom
       <dt .deflist__dt>Anmeldezeitraum
diff --git a/test/Database.hs b/test/Database.hs
index ab0d96b90..f90167b21 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -703,3 +703,25 @@ fillDb = do
   void . insert $ SystemMessage (Just now) Nothing False Info "de" "System-Nachrichten können längeren Inhalt enthalten" (Just "System-Nachricht Zusammenfassung")
   void . insert $ SystemMessage (Just now) (Just now) False Info "de" "System-Nachrichten haben Ablaufdaten" Nothing
   void . insert $ SystemMessage Nothing Nothing False Error "de" "System-Nachrichten können Inaktiv sein" Nothing
+
+
+  funAlloc <- insert' Allocation
+    { allocationName = "Funktionale Zentralanmeldung"
+    , allocationShorthand = "fun"
+    , allocationTerm = TermKey summer2018
+    , allocationSchool = ifi
+    , allocationDescription = Nothing
+    , allocationStaffDescription = Nothing
+    , allocationStaffRegisterFrom = Just now
+    , allocationStaffRegisterTo = Nothing
+    , allocationStaffAllocationFrom = Nothing
+    , allocationStaffAllocationTo = Nothing
+    , allocationRegisterFrom = Nothing
+    , allocationRegisterTo = Nothing
+    , allocationRegisterByStaffFrom = Nothing
+    , allocationRegisterByStaffTo = Nothing
+    , allocationRegisterByCourse = Nothing
+    , allocationOverrideDeregister = Just now
+    }
+  insert_ $ AllocationCourse funAlloc pmo 100
+  insert_ $ AllocationCourse funAlloc ffp 2

From c5b18fcfcf3b970039d2d72eab6d6f7e646d72ef Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Tue, 13 Aug 2019 17:51:12 +0200
Subject: [PATCH 2/7] feat(allocations): add registration form

---
 .../src/utils/form/interactive-fieldset.js    | 15 ++++-
 .../src/utils/form/interactive-fieldset.md    |  2 +
 messages/uniworx/de.msg                       | 26 +++++++
 routes                                        |  7 +-
 src/Foundation.hs                             |  7 ++
 src/Handler/Allocation.hs                     |  1 +
 src/Handler/Allocation/Register.hs            | 60 +++++++++++++++++
 src/Handler/Allocation/Show.hs                | 67 +++++++++++++++++--
 src/Model/Types/Security.hs                   |  1 +
 src/Utils.hs                                  |  6 +-
 templates/allocation/show.hamlet              | 61 +++++++++++++++++
 templates/allocation/show/course.hamlet       | 19 ++++++
 12 files changed, 260 insertions(+), 12 deletions(-)
 create mode 100644 src/Handler/Allocation/Register.hs
 create mode 100644 templates/allocation/show.hamlet
 create mode 100644 templates/allocation/show/course.hamlet

diff --git a/frontend/src/utils/form/interactive-fieldset.js b/frontend/src/utils/form/interactive-fieldset.js
index 5d24ee9c2..4155a81c9 100644
--- a/frontend/src/utils/form/interactive-fieldset.js
+++ b/frontend/src/utils/form/interactive-fieldset.js
@@ -16,6 +16,7 @@ export class InteractiveFieldset {
   conditionalValue;
   target;
   childInputs;
+  negated;
 
   constructor(element) {
     if (!element) {
@@ -48,6 +49,8 @@ export class InteractiveFieldset {
     }
     this.conditionalValue = this._element.dataset.conditionalValue;
 
+    this.negated = 'conditionalNegated' in this._element.dataset;
+
     this.target = this._element.closest(INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR);
     if (!this.target || this._element.matches(INTERACTIVE_FIELDSET_UTIL_TARGET_SELECTOR)) {
       this.target = this._element;
@@ -88,11 +91,19 @@ export class InteractiveFieldset {
   }
 
   _matchesConditionalValue() {
+    var matches;
+
     if (this._isCheckbox()) {
-      return this.conditionalInput.checked === true;
+      matches = this.conditionalInput.checked === true;
+    } else {
+      matches = this.conditionalInput.value === this.conditionalValue;
     }
 
-    return this.conditionalInput.value === this.conditionalValue;
+    if (this.negated) {
+      return !matches;
+    } else {
+      return matches;
+    }
   }
 
   _isCheckbox() {
diff --git a/frontend/src/utils/form/interactive-fieldset.md b/frontend/src/utils/form/interactive-fieldset.md
index 323c26e55..f98fdb0f4 100644
--- a/frontend/src/utils/form/interactive-fieldset.md
+++ b/frontend/src/utils/form/interactive-fieldset.md
@@ -8,6 +8,8 @@ Shows/hides inputs based on value of particular input
   Selector for the input that this fieldset watches for changes
 - `data-conditional-value: string`\
   The value the conditional input needs to be set to for this fieldset to be shown. Can be omitted if conditionalInput is a checkbox
+- `data-conditional-negated`\
+  If present, negates the match on `data-conditional-value`
 
 ## Example usage:
 ### example with text input
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index d58321527..871c909ca 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -350,6 +350,7 @@ UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung ein
 UnauthorizedSheetCorrector: Sie sind nicht als Korrektor für dieses Übungsblatt eingetragen.
 UnauthorizedCorrectorAny: Sie sind nicht als Korrektor für eine Veranstaltung eingetragen.
 UnauthorizedRegistered: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.
+UnauthorizedAllocationRegistered: Sie sind nicht als Teilnehmer für diese Zentralanmeldung registriert.
 UnauthorizedExamResult: Sie haben keine Ergebnisse in dieser Prüfung.
 UnauthorizedParticipant: Angegebener Benutzer ist nicht als Teilnehmer dieser Veranstaltung registriert.
 UnauthorizedCourseTime: Dieses Kurs erlaubt momentan keine Anmeldungen.
@@ -1019,6 +1020,7 @@ AuthTagTime: Zeitliche Einschränkungen sind erfüllt
 AuthTagStaffTime: Zeitliche Einschränkungen für Lehrbeteiligte sind erfüllt
 AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind erfüllt
 AuthTagCourseRegistered: Nutzer ist Kursteilnehmer
+AuthTagAllocationRegistered: Nutzer nimmt an der Zentralanmeldung teil
 AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer
 AuthTagExamRegistered: Nutzer ist Prüfungsteilnehmer
 AuthTagExamResult: Nutzer hat Prüfungsergebnisse
@@ -1448,3 +1450,27 @@ MailSubjectSchoolLecturerInvitation school@SchoolName: Einladung zum Dozent für
 MailSchoolLecturerInviteHeading school@SchoolName: Einladung zum Dozent für „#{school}“
 SchoolLecturerInviteExplanation: Sie wurden eingeladen, Dozent für ein Institut zu sein. Sie können, nachdem Sie die Einladung annehmen, eigenständig neue Kurse anlegen.
 SchoolLecturerInvitationAccepted school@SchoolName: Einladung zum Dozent für „#{school}“ angenommen
+
+AllocationTitle termText@Text ssh'@SchoolShorthand allocation@AllocationName: #{termText} - #{ssh'}: #{allocation}
+AllocationShortTitle termText@Text ssh'@SchoolShorthand ash@AllocationShorthand: #{termText} - #{ssh'} - #{ash}
+AllocationDescription: Beschreibung
+AllocationStaffRegisterFrom: Eintragung der Kurse ab
+AllocationStaffRegister: Eintragung der Kurse
+AllocationRegisterFrom: Bewerbung ab
+AllocationRegister: Bewerbung
+AllocationStaffAllocationFrom: Bewertung der Bewerbungen ab
+AllocationStaffAllocation: Bewertung der Bewerbungen
+AllocationNoApplication: Keine Bewerbung
+AllocationPriority: Priorität
+AllocationPriorityTip: Kurse, denen Sie eine höhere Priorität zuteilen, werden bei der Platzvergabe präferiert.
+AllocationPriorityRelative: Die absoluten Prioritäts-Werte sind bedeutungslos, es wird nur jeweils betrachtet ob ein Kurs höhere Priorität hat als ein anderer.
+AllocationTotalCoursesNegative: Gewünschte Kursanzahl muss größer null sein
+AllocationTotalCourses: Gewünschte Anzahl von Kursen
+AllocationTotalCoursesTip: Sie werden im Laufe dieser Zentralanmeldung maximal so vielen Kursen zugeteilt, wie Sie hier angeben
+AllocationRegistered: Teilnahme an der Zentralanmeldung erfolgreich registriert
+AllocationRegistrationEdited: Einstellungen zur Teilnahme an der Zentralanmeldung erfolgreich angepasst
+BtnAllocationRegister: Teilnahme registrieren
+BtnAllocationRegistrationEdit: Teilnahme anpassen
+AllocationParticipation: Teilnahme an der Zentralanmeldung
+AllocationCourses: Kurse
+AllocationData: Organisatorisches
\ No newline at end of file
diff --git a/routes b/routes
index d8cbe8260..ac009ecc1 100644
--- a/routes
+++ b/routes
@@ -81,9 +81,10 @@
 /school/#SchoolId          SchoolShowR         GET             !development
 
 /allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
-  /                                              AShowR   GET             !free
-  /course/#CryptoUUIDCourse/apply                AApplyR      POST        !time
-  /application/#CryptoFileNameCourseApplication  AEditR   GET POST        !timeANDself !lecturerANDstaff-time
+  /                                              AShowR     GET             !free
+  /register                                      ARegisterR     POST        !time
+  /course/#CryptoUUIDCourse/apply                AApplyR        POST        !timeANDallocation-registered
+  /application/#CryptoFileNameCourseApplication  AEditR     GET POST        !timeANDself !lecturerANDstaff-time
 
 
 -- For Pattern Synonyms see Foundation
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 3cfa94442..78b3c0e8b 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1024,6 +1024,13 @@ tagAccessPredicate AuthExamResult = APDB $ \mAuthId route _ -> case route of
     guardMExceptT hasResult (unauthorizedI MsgUnauthorizedExamResult)
     return Authorized
   r -> $unsupportedAuthPredicate AuthExamRegistered r
+tagAccessPredicate AuthAllocationRegistered = APDB $ \mAuthId route _ -> case route of
+  AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegistered) $ do
+    uid <- hoistMaybe mAuthId
+    aId <- MaybeT . $cachedHereBinary (tid, ssh, ash) . getKeyBy $ TermSchoolAllocationShort tid ssh ash
+    void . MaybeT . $cachedHereBinary (uid, aId) . getKeyBy $ UniqueAllocationUser aId uid
+    return Authorized
+  r -> $unsupportedAuthPredicate AuthAllocationRegistered r
 tagAccessPredicate AuthParticipant = APDB $ \_ route _ -> case route of
   CourseR tid ssh csh (CUserR cID) -> exceptT return return $ do
     let authorizedIfExists f = do
diff --git a/src/Handler/Allocation.hs b/src/Handler/Allocation.hs
index bed822b0d..5f97daec5 100644
--- a/src/Handler/Allocation.hs
+++ b/src/Handler/Allocation.hs
@@ -4,3 +4,4 @@ module Handler.Allocation
 
 import Handler.Allocation.Show as Handler.Allocation
 import Handler.Allocation.Edit as Handler.Allocation
+import Handler.Allocation.Register as Handler.Allocation
diff --git a/src/Handler/Allocation/Register.hs b/src/Handler/Allocation/Register.hs
new file mode 100644
index 000000000..0c19a866d
--- /dev/null
+++ b/src/Handler/Allocation/Register.hs
@@ -0,0 +1,60 @@
+module Handler.Allocation.Register
+  ( AllocationRegisterForm(..)
+  , AllocationRegisterButton(..)
+  , allocationRegisterForm
+  , allocationUserToForm
+  , postARegisterR
+  ) where
+
+import Import
+
+import Utils.Lens
+
+import Handler.Utils.Form
+
+
+data AllocationRegisterForm = AllocationRegisterForm
+  { arfTotalCourses :: Natural
+  }
+
+allocationRegisterForm :: Maybe AllocationRegisterForm -> AForm Handler AllocationRegisterForm
+allocationRegisterForm template
+  = AllocationRegisterForm
+    <$> areq (posIntFieldI MsgAllocationTotalCoursesNegative) (fslI MsgAllocationTotalCourses & setTooltip MsgAllocationTotalCoursesTip) (arfTotalCourses <$> template <|> Just 1)
+
+allocationUserToForm :: AllocationUser -> AllocationRegisterForm
+allocationUserToForm AllocationUser{..} = AllocationRegisterForm
+  { arfTotalCourses = allocationUserTotalCourses
+  }
+
+data AllocationRegisterButton = BtnAllocationRegister | BtnAllocationRegistrationEdit
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+instance Universe AllocationRegisterButton
+instance Finite AllocationRegisterButton
+
+nullaryPathPiece ''AllocationRegisterButton $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''AllocationRegisterButton id
+
+instance Button UniWorX AllocationRegisterButton where
+  btnClasses _ = [BCIsButton, BCPrimary]
+
+postARegisterR :: TermId -> SchoolId -> AllocationShorthand -> Handler Void
+postARegisterR tid ssh ash = do
+  uid <- requireAuthId
+
+  ((registerRes, _), _) <- runFormPost . renderAForm FormStandard $ allocationRegisterForm Nothing
+  formResult registerRes $ \AllocationRegisterForm{..} -> runDB $ do
+    aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
+    isRegistered <- existsBy $ UniqueAllocationUser aId uid
+    void $ upsert AllocationUser 
+      { allocationUserAllocation = aId
+      , allocationUserUser = uid
+      , allocationUserTotalCourses = arfTotalCourses
+      }
+      [ AllocationUserTotalCourses =. arfTotalCourses
+      ]
+    if
+      | isRegistered -> addMessageI Success MsgAllocationRegistrationEdited
+      | otherwise -> addMessageI Success MsgAllocationRegistered
+  
+  redirect $ AllocationR tid ssh ash AShowR :#: ("allocation-participation" :: Text)
diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs
index 71f1f3967..f1eba5304 100644
--- a/src/Handler/Allocation/Show.hs
+++ b/src/Handler/Allocation/Show.hs
@@ -3,13 +3,68 @@ module Handler.Allocation.Show
   ) where
 
 import Import
+import Handler.Utils
+import Utils.Lens
+
+import Handler.Allocation.Register
+
+import qualified Database.Esqueleto as E
+  
 
 getAShowR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
 getAShowR tid ssh ash = do
-  Entity _ alloc <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash
+  muid <- maybeAuthId
 
-  defaultLayout $ -- TODO
-    [whamlet|
-      <pre>
-        #{tshow alloc}
-    |]
+  let
+    resultCourse :: Lens' (Entity Course, _, _) (Entity Course)
+    resultCourse = _1
+    -- resultCourseApplication = _2
+    resultHasTemplate = _3 . _Value
+
+  (Entity _ Allocation{..}, courses, registration) <- runDB $ do
+    alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
+
+    courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication) -> do
+      E.on $ courseApplication E.?. CourseApplicationCourse E.==. E.just (course E.^. CourseId)
+       E.&&. courseApplication E.?. CourseApplicationUser E.==. E.val muid
+       E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)
+      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+      E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+      let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
+            E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
+      return (course, courseApplication, hasTemplate)
+
+    registration <- fmap join . for muid $ getBy . UniqueAllocationUser aId
+
+    return (alloc, nubOn (view $ resultCourse . _entityKey) courses, registration)
+
+  MsgRenderer mr <- getMsgRenderer
+  let title = MsgAllocationTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationName
+      shortTitle = MsgAllocationShortTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationShorthand
+
+  staffInformation <- anyM courses $ \(view $ resultCourse . _entityVal -> Course{..}) ->
+    hasReadAccessTo $ CourseR courseTerm courseSchool courseShorthand CApplicationsR
+  mayRegister <- hasWriteAccessTo $ AllocationR tid ssh ash ARegisterR
+  (registerForm, registerEnctype) <- generateFormPost . renderAForm FormStandard . allocationRegisterForm $ allocationUserToForm . entityVal <$> registration
+  let
+    registerBtn = bool BtnAllocationRegister BtnAllocationRegistrationEdit $ is _Just registration
+    registerForm' = wrapForm' registerBtn registerForm FormSettings
+      { formMethod = POST
+      , formAction = Just . SomeRoute $ AllocationR tid ssh ash ARegisterR
+      , formEncoding = registerEnctype
+      , formAttrs = []
+      , formSubmit = FormSubmit
+      , formAnchor = Nothing :: Maybe Text
+      }
+
+  siteLayoutMsg title $ do
+    setTitleI shortTitle
+
+    let courseWidgets = flip map courses $ \cEntry -> do
+          let Entity cid Course{..}  = cEntry ^. resultCourse
+              hasApplicationTemplate = cEntry ^. resultHasTemplate
+          cID <- encrypt cid :: WidgetT UniWorX IO CryptoUUIDCourse
+          mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
+          $(widgetFile "allocation/show/course")
+  
+    $(widgetFile "allocation/show")
diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs
index 5503f9877..fe1739fd0 100644
--- a/src/Model/Types/Security.hs
+++ b/src/Model/Types/Security.hs
@@ -42,6 +42,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
   | AuthLecturer
   | AuthCorrector
   | AuthTutor
+  | AuthAllocationRegistered
   | AuthCourseRegistered
   | AuthTutorialRegistered
   | AuthExamRegistered
diff --git a/src/Utils.hs b/src/Utils.hs
index 795787841..db521a099 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -1,5 +1,6 @@
 module Utils
   ( module Utils
+  , List.nub, List.nubBy
   ) where
 
 import ClassyPrelude.Yesod hiding (foldlM, Proxy)
@@ -39,7 +40,7 @@ import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Map (Map)
 import qualified Data.Map as Map
--- import qualified Data.List as List
+import qualified Data.List as List
 
 import Control.Lens
 import Control.Lens as Utils (none)
@@ -376,6 +377,9 @@ partitionWith f (x:xs) = case f x of
 nonEmpty' :: Alternative f => [a] -> f (NonEmpty a)
 nonEmpty' = maybe empty pure . nonEmpty
 
+nubOn :: Eq b => (a -> b) -> [a] -> [a]
+nubOn = List.nubBy . ((==) `on`)
+
 ----------
 -- Sets --
 ----------
diff --git a/templates/allocation/show.hamlet b/templates/allocation/show.hamlet
new file mode 100644
index 000000000..74711e783
--- /dev/null
+++ b/templates/allocation/show.hamlet
@@ -0,0 +1,61 @@
+$newline never
+<section>
+  $# <h2>
+  $#   _{MsgAllocationData}
+  <dl .deflist>
+    $maybe desc <- allocationDescription
+      <dt .deflist__dt>
+        _{MsgAllocationDescription}
+      <dd .deflist__dd>
+        #{desc}
+    $maybe fromT <- allocationStaffRegisterFrom
+      <dt .deflist__dt>
+        $maybe _ <- allocationStaffRegisterTo
+          _{MsgAllocationStaffRegister}
+        $nothing
+          _{MsgAllocationStaffRegisterFrom}
+      <dd .deflist__dd>
+        ^{formatTimeRangeW SelFormatDateTime fromT allocationStaffRegisterTo}
+    $maybe fromT <- allocationRegisterFrom
+      <dt .deflist__dt>
+        $maybe _ <- allocationRegisterTo
+          _{MsgAllocationRegister}
+        $nothing
+          _{MsgAllocationRegisterFrom}
+      <dd .deflist__dd>
+        ^{formatTimeRangeW SelFormatDateTime fromT allocationRegisterTo}
+    $if staffInformation
+      $maybe fromT <- allocationStaffAllocationFrom
+        <dt .deflist__dt>
+          $maybe _ <- allocationStaffAllocationTo
+            _{MsgAllocationStaffAllocation}
+          $nothing
+            _{MsgAllocationStaffAllocationFrom}
+        <dd .deflist__dd>
+          ^{formatTimeRangeW SelFormatDateTime fromT allocationStaffAllocationTo}
+
+$if mayRegister || is _Just registration
+  <section id=allocation-participation>
+    <h2>
+      _{MsgAllocationParticipation}
+    $if mayRegister
+      ^{registerForm'}
+    $else
+      $maybe Entity _ AllocationUser{allocationUserTotalCourses} <- registration
+        <dl .deflist>
+          <dt .deflist__dt>
+            _{MsgAllocationTotalCourses}
+          <dd .deflist__dd>
+            #{allocationUserTotalCourses}
+
+$if not (null courseWidgets)
+  <section .allocation>
+    <h2>
+      _{MsgAllocationCourses}
+    <div .allocation__explanation>
+      <p>_{MsgAllocationPriorityTip}
+      <p>_{MsgAllocationPriorityRelative}
+    <div .allocation__priority-label>
+      _{MsgAllocationPriority}
+    $forall courseWgt <- courseWidgets
+      ^{courseWgt}
diff --git a/templates/allocation/show/course.hamlet b/templates/allocation/show/course.hamlet
new file mode 100644
index 000000000..4714f18b5
--- /dev/null
+++ b/templates/allocation/show/course.hamlet
@@ -0,0 +1,19 @@
+<div .allocation-course id=#{toPathPiece cID}>
+  <div .allocation-course__priority>
+    $if mayApply
+      Prio $# TODO
+    $else
+      _{MsgAllocationNoApplication}
+  <a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR}>
+    #{courseName}
+  $maybe aInst <- courseApplicationsInstructions
+    <div .allocation-course__instructions>
+      <p>
+        #{aInst}
+      $if hasApplicationTemplate
+        <p>
+          <a href=@{CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR}>
+            #{iconRegisterTemplate} _{MsgCourseApplicationTemplateApplication}
+  $if mayApply
+    <div .allocation-course__application uw-interactive-fieldset data-conditional-input="" data-conditional-value="" data-conditional-negated>
+      

From ef625cd901bddc1e770bdae82ffb420b434087c1 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 14 Aug 2019 15:06:43 +0200
Subject: [PATCH 3/7] feat(allocations): add application form(s)

---
 .../services/util-registry/util-registry.js   |   2 +-
 .../src/utils/form/interactive-fieldset.js    |   2 +-
 messages/uniworx/de.msg                       |  18 +-
 models/courses                                |   2 +
 routes                                        |   8 +-
 src/Foundation.hs                             |   8 +-
 src/Handler/Allocation.hs                     |   2 +-
 src/Handler/Allocation/Application.hs         | 223 ++++++++++++++++++
 src/Handler/Allocation/Edit.hs                |  13 -
 src/Handler/Allocation/Show.hs                |  30 ++-
 src/Handler/Course/Register.hs                |   2 +-
 src/Utils/Form.hs                             |  35 +++
 src/Utils/Lens.hs                             |   2 +
 templates/allocation/show/course.hamlet       |  13 +-
 14 files changed, 325 insertions(+), 35 deletions(-)
 create mode 100644 src/Handler/Allocation/Application.hs
 delete mode 100644 src/Handler/Allocation/Edit.hs

diff --git a/frontend/src/services/util-registry/util-registry.js b/frontend/src/services/util-registry/util-registry.js
index d96d7a4b3..c6e866adf 100644
--- a/frontend/src/services/util-registry/util-registry.js
+++ b/frontend/src/services/util-registry/util-registry.js
@@ -1,4 +1,4 @@
-const DEBUG_MODE = /localhost/.test(window.location.href) && 0;
+const DEBUG_MODE = /localhost/.test(window.location.href) ? 2 : 0;
 
 export class UtilRegistry {
 
diff --git a/frontend/src/utils/form/interactive-fieldset.js b/frontend/src/utils/form/interactive-fieldset.js
index 4155a81c9..9c080e04f 100644
--- a/frontend/src/utils/form/interactive-fieldset.js
+++ b/frontend/src/utils/form/interactive-fieldset.js
@@ -44,7 +44,7 @@ export class InteractiveFieldset {
     }
 
     // param conditionalValue
-    if (!this._element.dataset.conditionalValue && !this._isCheckbox()) {
+    if (!('conditionalValue' in this._element.dataset) && !this._isCheckbox()) {
       throw new Error('Interactive Fieldset needs a conditional value!');
     }
     this.conditionalValue = this._element.dataset.conditionalValue;
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 871c909ca..0d12afe08 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -332,7 +332,7 @@ MaterialArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand materialName@Mat
 Unauthorized: Sie haben hierfür keine explizite Berechtigung.
 UnauthorizedAnd l@Text r@Text: (#{l} UND #{r})
 UnauthorizedOr  l@Text r@Text: (#{l} ODER #{r})
-UnauthorizedNot i@Text: (NICHT #{i})
+UnauthorizedNot r@Text: (NICHT #{r})
 UnauthorizedNoToken: Ihrer Anfrage war kein Authorisierungs-Token beigefügt.
 UnauthorizedTokenExpired: Ihr Authorisierungs-Token ist abgelaufen.
 UnauthorizedTokenNotStarted: Ihr Authorisierungs-Token ist noch nicht gültig.
@@ -1473,4 +1473,18 @@ BtnAllocationRegister: Teilnahme registrieren
 BtnAllocationRegistrationEdit: Teilnahme anpassen
 AllocationParticipation: Teilnahme an der Zentralanmeldung
 AllocationCourses: Kurse
-AllocationData: Organisatorisches
\ No newline at end of file
+AllocationData: Organisatorisches
+AllocationCoursePriority i@Natural: #{i}. Wahl
+AllocationCourseNoApplication: Keine Bewerbung
+BtnAllocationApply: Bewerben
+BtnAllocationApplicationEdit: Bewerbung ersetzen
+BtnAllocationApplicationRetract: Bewerbung zurückziehen
+BtnAllocationApplicationRate: Bewerbung bewerten
+ApplicationPriority: Priorität
+ApplicationVeto: Veto
+ApplicationVetoTip: Bewerber mit Veto werden garantiert nicht dem Kurs zugeteilt
+ApplicationRatingPoints: Bewertung
+ApplicationRatingPointsTip: Bewerber mit 5.0 werden garantiert nicht dem Kurs zugeteilt
+ApplicationRatingComment: Kommentar
+ApplicationRatingCommentVisibleTip: Feedback an den Bewerbers
+ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursverwalter
\ No newline at end of file
diff --git a/models/courses b/models/courses
index bcbdf4979..dd1099e55 100644
--- a/models/courses
+++ b/models/courses
@@ -76,11 +76,13 @@ CourseApplication
     user                UserId
     field               StudyFeaturesId Maybe -- associated degree course, user-defined; required for communicating grades
     text                Text            Maybe -- free text entered by user
+    ratingVeto          Bool                  default=false
     ratingPoints        ExamGrade       Maybe
     ratingComment       Text            Maybe
     allocation          AllocationId    Maybe
     allocationPriority  Natural         Maybe
     time                UTCTime               default=now()
+    ratingTime          UTCTime         Maybe
 CourseApplicationFile 
     application         CourseApplicationId
     file                FileId
diff --git a/routes b/routes
index ac009ecc1..cec9b58f7 100644
--- a/routes
+++ b/routes
@@ -81,10 +81,10 @@
 /school/#SchoolId          SchoolShowR         GET             !development
 
 /allocation/#TermId/#SchoolId/#AllocationShorthand AllocationR:
-  /                                              AShowR     GET             !free
-  /register                                      ARegisterR     POST        !time
-  /course/#CryptoUUIDCourse/apply                AApplyR        POST        !timeANDallocation-registered
-  /application/#CryptoFileNameCourseApplication  AEditR     GET POST        !timeANDself !lecturerANDstaff-time
+  /                                              AShowR         GET             !free
+  /register                                      ARegisterR         POST        !time
+  /course/#CryptoUUIDCourse/apply                AApplyR            POST        !timeANDallocation-registered
+  /application/#CryptoFileNameCourseApplication  AApplicationR  GET POST        !timeANDself !lecturerANDstaff-time !selfANDread
 
 
 -- For Pattern Synonyms see Foundation
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 78b3c0e8b..6b47320ad 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -261,6 +261,8 @@ instance RenderMessage UniWorX Int64 where
   renderMessage f ls = renderMessage f ls . tshow
 instance RenderMessage UniWorX Integer where
   renderMessage f ls = renderMessage f ls . tshow
+instance RenderMessage UniWorX Natural where
+  renderMessage f ls = renderMessage f ls . tshow
 
 instance HasResolution a => RenderMessage UniWorX (Fixed a) where
   renderMessage f ls = renderMessage f ls . showFixed True
@@ -371,6 +373,8 @@ instance ToMessage Int64 where
   toMessage = tshow
 instance ToMessage Integer where
   toMessage = tshow
+instance ToMessage Natural where
+  toMessage = tshow
 
 instance HasResolution a => ToMessage (Fixed a) where
   toMessage = toMessage . showFixed True
@@ -652,7 +656,7 @@ tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
             E.&&. course E.^. CourseShorthand E.==. E.val csh
      guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedLecturer)
      return Authorized
-  AllocationR tid ssh ash (AEditR cID) -> $cachedHereBinary (mAuthId, tid, ssh, ash, cID) . exceptT return return $ do
+  AllocationR tid ssh ash (AApplicationR cID) -> $cachedHereBinary (mAuthId, tid, ssh, ash, cID) . exceptT return return $ do
     authId <- maybeExceptT AuthenticationRequired $ return mAuthId
     appId <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedLecturer) (const True :: CryptoIDError -> Bool) $ decrypt cID
     isLecturer <- lift . E.selectExists . E.from $ \(courseApplication `E.InnerJoin` allocation `E.InnerJoin` allocationCourse `E.InnerJoin` course `E.InnerJoin` lecturer) -> do
@@ -1733,7 +1737,7 @@ instance YesodBreadcrumbs UniWorX where
     mr <- getMessageRender
     Entity _ Allocation{allocationName} <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash
     return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ HomeR)
-  breadcrumb (AllocationR tid ssh ash (AEditR _)) = return ("Bewerbung", Just $ AllocationR tid ssh ash AShowR)
+  breadcrumb (AllocationR tid ssh ash (AApplicationR _)) = return ("Bewerbung", Just $ AllocationR tid ssh ash AShowR)
 
   breadcrumb  CourseListR                 = return ("Kurse"    , Nothing)
   breadcrumb  CourseNewR                  = return ("Neu"      , Just CourseListR)
diff --git a/src/Handler/Allocation.hs b/src/Handler/Allocation.hs
index 5f97daec5..286a87aa1 100644
--- a/src/Handler/Allocation.hs
+++ b/src/Handler/Allocation.hs
@@ -3,5 +3,5 @@ module Handler.Allocation
   ) where
 
 import Handler.Allocation.Show as Handler.Allocation
-import Handler.Allocation.Edit as Handler.Allocation
+import Handler.Allocation.Application as Handler.Allocation
 import Handler.Allocation.Register as Handler.Allocation
diff --git a/src/Handler/Allocation/Application.hs b/src/Handler/Allocation/Application.hs
new file mode 100644
index 000000000..0b970cb0f
--- /dev/null
+++ b/src/Handler/Allocation/Application.hs
@@ -0,0 +1,223 @@
+module Handler.Allocation.Application
+  ( AllocationApplicationButton(..)
+  , ApplicationFormView(..)
+  , ApplicationForm(..)
+  , ApplicationFormMode(..)
+  , ApplicationFormException(..)
+  , applicationForm
+  , postAApplyR
+  , getAApplicationR, postAApplicationR
+  ) where
+
+import Import
+
+import Handler.Utils
+import Utils.Lens
+
+import qualified Data.Text as Text
+
+
+data AllocationApplicationButton = BtnAllocationApply
+                                 | BtnAllocationApplicationEdit
+                                 | BtnAllocationApplicationRetract
+                                 | BtnAllocationApplicationRate
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+instance Universe AllocationApplicationButton
+instance Finite AllocationApplicationButton
+
+nullaryPathPiece ''AllocationApplicationButton $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''AllocationApplicationButton id
+
+instance Button UniWorX AllocationApplicationButton where
+  btnClasses BtnAllocationApplicationRetract = [BCIsButton, BCDanger]
+  btnClasses _ = [BCIsButton, BCPrimary]
+
+
+data ApplicationFormView = ApplicationFormView
+  { afvPriority :: Maybe (FieldView UniWorX)
+  , afvForm     :: [FieldView UniWorX]
+  , afvButtons  :: ([AllocationApplicationButton], Widget)
+  }
+
+data ApplicationForm = ApplicationForm
+  { afPriority      :: Maybe Natural
+  , afField         :: Maybe StudyFeaturesId
+  , afText          :: Maybe Text
+  , afFiles         :: Maybe (Source Handler File)
+  , afRatingVeto    :: Bool
+  , afRatingPoints  :: Maybe ExamGrade
+  , afRatingComment :: Maybe Text
+  , afAction        :: AllocationApplicationButton
+  }
+
+data ApplicationFormMode = ApplicationFormMode
+  { afmApplicant     :: Bool -- ^ Show priority
+  , afmApplicantEdit :: Bool -- ^ Allow editing text, files, priority (if shown)
+  , afmLecturer      :: Bool -- ^ Allow editing rating
+  }
+
+data ApplicationFormException = ApplicationFormNoApplication -- ^ Could not fill forced fields of application form with data from application
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+instance Exception ApplicationFormException
+
+applicationForm :: AllocationId
+                -> CourseId
+                -> UserId
+                -> Natural -- ^ Maximum @courseApplicationAllocationPriority@ among all applications
+                -> ApplicationFormMode -- ^ Which parts of the shared form to display
+                -> Html -> MForm Handler (FormResult ApplicationForm, ApplicationFormView)
+applicationForm aId cid uid maxPrio ApplicationFormMode{..} csrf = do
+  (mApp, coursesNum, Course{..}) <- liftHandlerT . runDB $ do
+    mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. Just aId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
+    coursesNum <- fromIntegral <$> count [AllocationCourseAllocation ==. aId]
+    course <- getJust cid
+    return (mApplication, coursesNum, course)
+  MsgRenderer mr <- getMsgRenderer
+
+  let
+    oldPrio :: Maybe Natural
+    oldPrio = mApp >>= courseApplicationAllocationPriority . entityVal
+
+    coursesNum' = succ maxPrio `max` pred coursesNum
+
+    mkPrioOption :: Natural -> Option Natural
+    mkPrioOption i = Option
+      { optionDisplay       = mr . MsgAllocationCoursePriority $ coursesNum' - i 
+      , optionInternalValue = i
+      , optionExternalValue = tshow i
+      }
+    
+    prioOptions :: OptionList Natural
+    prioOptions = OptionList
+      { olOptions = sortOn (Down . optionInternalValue) . map mkPrioOption $ [0 .. coursesNum']
+      , olReadExternal = readMay
+      }
+    prioField = selectField' (Just $ SomeMessage MsgAllocationCourseNoApplication) $ return prioOptions
+      
+  (prioRes, prioView) <- case (afmApplicant, afmApplicantEdit, mApp) of
+    (True , True , Nothing)
+      -> over _2 Just <$> mopt prioField (fslI MsgApplicationPriority) (Just $ oldPrio) 
+    (True , True , Just _ )
+      -> over (_1 . _FormSuccess) Just . over _2 Just <$> mreq prioField (fslI MsgApplicationPriority) oldPrio
+    (True , False, _      )
+      -> over _2 Just <$> mforcedOpt prioField (fslI MsgApplicationPriority) oldPrio 
+    (False, _   , Just _ )
+      | is _Just oldPrio
+        -> pure (FormSuccess oldPrio, Nothing)
+    _other
+      -> throwM ApplicationFormNoApplication
+
+  (fieldRes, fieldView') <- if
+    | afmApplicantEdit || afmLecturer
+      -> mreq (studyFeaturesFieldFor Nothing False [] $ Just uid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) (courseApplicationField . entityVal <$> mApp)
+    | otherwise
+      -> mforced (studyFeaturesFieldFor Nothing True (maybeToList $ mApp >>= courseApplicationField . entityVal) $ Just uid) (fslI MsgCourseStudyFeature & setTooltip MsgCourseStudyFeatureTip) (mApp >>= courseApplicationField . entityVal)
+
+  let textField' = convertField (Text.strip . unTextarea) Textarea textareaField
+      textFs
+        | is _Just courseApplicationsInstructions
+        = fslI MsgCourseApplicationText & setTooltip MsgCourseApplicationFollowInstructions
+        | otherwise
+        = fslI MsgCourseApplicationText
+  (textRes, textView) <- if
+    | not courseApplicationsText
+      -> pure (FormSuccess Nothing, Nothing)
+    | not afmApplicantEdit
+      -> over _2 Just <$> mforcedOpt textField' textFs (mApp >>= courseApplicationText . entityVal)
+    | otherwise
+      -> over _2 Just . over (_1 . _FormSuccess) (assertM $ not . Text.null) <$> mopt textField' textFs (Just $ mApp >>= courseApplicationText . entityVal)
+
+  hasFiles <- for mApp $ \(Entity appId _)
+    -> fmap (not . null) . liftHandlerT . runDB $ selectKeysList [ CourseApplicationFileApplication ==. appId ] [ LimitTo 1 ]
+  appCID <- for mApp $ encrypt . entityKey
+  let appFilesInfo = (,) <$> hasFiles <*> appCID
+
+  filesLinkView <- if
+    | fromMaybe False hasFiles || (isn't _NoUpload courseApplicationsFiles && not afmApplicantEdit)
+      -> let filesLinkField = Field{..}
+               where
+                 fieldParse _ _ = return $ Right Nothing
+                 fieldEnctype = mempty
+                 fieldView theId _ attrs _ _
+                   = [whamlet|
+                       $newline never
+                         $case appFilesInfo
+                           $of Just (True, appCID)
+                             <a ##{theId} *{attrs} href=@{CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR}>
+                               _{MsgCourseApplicationFiles}
+                           $of _
+                             <span ##{theId} *{attrs}>
+                               _{MsgCourseApplicationNoFiles}
+                     |]
+          in Just . snd <$> mforced filesLinkField (fslI MsgCourseApplicationFiles) ()
+    | otherwise
+      -> return Nothing
+
+  (filesRes, filesView) <-
+    let mkFs = bool MsgCourseApplicationFile MsgCourseApplicationArchive
+     in if
+      | not afmApplicantEdit || is _NoUpload courseApplicationsFiles
+        -> return $ (FormSuccess Nothing, Nothing)
+      | otherwise
+        -> fmap (over _2 $ Just . ($ [])) . aFormToForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
+
+  (vetoRes, vetoView) <- if
+    | afmLecturer
+      -> over _2 Just <$> mpopt checkBoxField (fslI MsgApplicationVeto & setTooltip MsgApplicationVetoTip) (Just . fromMaybe False $ courseApplicationRatingVeto . entityVal <$> mApp)
+    | otherwise
+      -> return (FormSuccess . fromMaybe False $ courseApplicationRatingVeto . entityVal <$> mApp, Nothing)
+  
+  (pointsRes, pointsView) <- if
+    | afmLecturer
+      -> over _2 Just <$> mopt examGradeField (fslI MsgApplicationRatingPoints & setTooltip MsgApplicationRatingPointsTip) (fmap Just $ mApp >>= courseApplicationRatingPoints . entityVal)
+    | otherwise
+      -> return (FormSuccess $ courseApplicationRatingPoints . entityVal =<< mApp, Nothing)
+
+  (commentRes, commentView) <- if
+    | afmLecturer
+      -> over _2 Just . over (_1 . _FormSuccess) (assertM $ not . Text.null) <$> mopt textField' (fslI MsgApplicationRatingComment & setTooltip (bool MsgApplicationRatingCommentInvisibleTip MsgApplicationRatingCommentVisibleTip courseApplicationsRatingsVisible)) (fmap Just $ mApp >>= courseApplicationRatingComment . entityVal)
+    | otherwise
+      -> return (FormSuccess $ courseApplicationRatingComment . entityVal =<< mApp, Nothing)
+  
+  let
+    buttons = catMaybes
+      [ guardOn (not afmApplicantEdit && is _Just    mApp) BtnAllocationApplicationRate
+      , guardOn (    afmApplicantEdit && is _Just    mApp) BtnAllocationApplicationEdit
+      , guardOn (    afmApplicantEdit && is _Nothing mApp) BtnAllocationApply
+      , guardOn (    afmApplicantEdit && is _Just    mApp) BtnAllocationApplicationRetract
+      ]
+  (actionRes, buttonsView) <- buttonForm' buttons csrf
+
+  return ( ApplicationForm
+           <$> prioRes
+           <*> fieldRes
+           <*> textRes
+           <*> filesRes
+           <*> vetoRes
+           <*> pointsRes
+           <*> commentRes
+           <*> actionRes
+         , ApplicationFormView
+           { afvPriority = prioView
+           , afvForm = catMaybes $ 
+             [ Just fieldView'
+             , textView
+             , filesLinkView
+             ] ++ maybe [] (map Just) filesView ++
+             [ vetoView
+             , pointsView
+             , commentView
+             ]
+           , afvButtons = (buttons, buttonsView)
+           }
+         )
+
+ 
+
+
+postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
+postAApplyR = fail "Not implemented"
+
+getAApplicationR, postAApplicationR :: TermId -> SchoolId -> AllocationShorthand -> CryptoFileNameCourseApplication -> Handler Void
+getAApplicationR = postAApplicationR
+postAApplicationR = fail "Not implemented"
diff --git a/src/Handler/Allocation/Edit.hs b/src/Handler/Allocation/Edit.hs
deleted file mode 100644
index d9362babb..000000000
--- a/src/Handler/Allocation/Edit.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Handler.Allocation.Edit
-  ( postAApplyR
-  , getAEditR, postAEditR
-  ) where
-
-import Import
-
-postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
-postAApplyR = fail "Not implemented"
-
-getAEditR, postAEditR :: TermId -> SchoolId -> AllocationShorthand -> CryptoFileNameCourseApplication -> Handler Void
-getAEditR = postAEditR
-postAEditR = fail "Not implemented"
diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs
index f1eba5304..b386021c3 100644
--- a/src/Handler/Allocation/Show.hs
+++ b/src/Handler/Allocation/Show.hs
@@ -7,6 +7,7 @@ import Handler.Utils
 import Utils.Lens
 
 import Handler.Allocation.Register
+import Handler.Allocation.Application
 
 import qualified Database.Esqueleto as E
   
@@ -16,12 +17,14 @@ getAShowR tid ssh ash = do
   muid <- maybeAuthId
 
   let
-    resultCourse :: Lens' (Entity Course, _, _) (Entity Course)
+    resultCourse :: Simple Field1 a (Entity Course) => Lens' a (Entity Course)
     resultCourse = _1
-    -- resultCourseApplication = _2
+    resultCourseApplication :: Simple Field2 a (Maybe (Entity CourseApplication)) => Traversal' a (Entity CourseApplication)
+    resultCourseApplication = _2 . _Just
+    resultHasTemplate :: Simple Field3 a (E.Value Bool) => Lens' a Bool 
     resultHasTemplate = _3 . _Value
 
-  (Entity _ Allocation{..}, courses, registration) <- runDB $ do
+  (Entity aId Allocation{..}, courses, registration) <- runDB $ do
     alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
 
     courses <- E.select . E.from $ \((allocationCourse `E.InnerJoin` course) `E.LeftOuterJoin` courseApplication) -> do
@@ -30,6 +33,7 @@ getAShowR tid ssh ash = do
        E.&&. courseApplication E.?. CourseApplicationAllocation E.==. E.just (E.just $ E.val aId)
       E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
       E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+      E.orderBy [E.asc $ course E.^. CourseName]
       let hasTemplate = E.exists . E.from $ \courseAppInstructionFile ->
             E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
       return (course, courseApplication, hasTemplate)
@@ -56,6 +60,8 @@ getAShowR tid ssh ash = do
       , formSubmit = FormSubmit
       , formAnchor = Nothing :: Maybe Text
       }
+  let
+    maxPrio = maybe 0 maximum . fromNullable $ courses ^.. folded . resultCourseApplication . _entityVal . _courseApplicationAllocationPriority . _Just
 
   siteLayoutMsg title $ do
     setTitleI shortTitle
@@ -63,8 +69,24 @@ getAShowR tid ssh ash = do
     let courseWidgets = flip map courses $ \cEntry -> do
           let Entity cid Course{..}  = cEntry ^. resultCourse
               hasApplicationTemplate = cEntry ^. resultHasTemplate
+              mApp                   = cEntry ^? resultCourseApplication
           cID <- encrypt cid :: WidgetT UniWorX IO CryptoUUIDCourse
           mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
-          $(widgetFile "allocation/show/course")
+          isLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
+          mApplyFormView <- liftHandlerT . for muid $ \uid -> generateFormPost . applicationForm aId cid uid maxPrio $ ApplicationFormMode True mayApply isLecturer
+          subRoute <- fmap (fromMaybe $ AApplyR cID) . for mApp $ \(Entity appId _) -> AApplicationR <$> encrypt appId
+          let mApplyFormView' = view _1 <$> mApplyFormView
+          case mApplyFormView of
+            Just (_, appFormEnctype)
+              -> wrapForm $(widgetFile "allocation/show/course") FormSettings
+                 { formMethod = POST
+                 , formAction = Just . SomeRoute $ AllocationR tid ssh ash subRoute
+                 , formEncoding = appFormEnctype
+                 , formAttrs = []
+                 , formSubmit = FormNoSubmit
+                 , formAnchor = Nothing :: Maybe Text
+                 }
+            Nothing
+              -> $(widgetFile "allocation/show/course")
   
     $(widgetFile "allocation/show")
diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs
index 0d42bba87..860835bf3 100644
--- a/src/Handler/Course/Register.hs
+++ b/src/Handler/Course/Register.hs
@@ -177,7 +177,7 @@ postCRegisterR tid ssh csh = do
         = void <$> do
             appIds <- selectKeysList [ CourseApplicationAllocation ==. Nothing, CourseApplicationCourse ==. cid, CourseApplicationUser ==. uid ] []
             appRes <- case appIds of
-              [] -> insertUnique $ CourseApplication cid uid crfStudyFeatures crfApplicationText Nothing Nothing Nothing Nothing cTime
+              [] -> insertUnique $ CourseApplication cid uid crfStudyFeatures crfApplicationText False Nothing Nothing Nothing Nothing cTime Nothing
               (prevId:ps) -> do
                 forM_ ps $ \appId -> do
                   deleteApplicationFiles appId
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index c54ed44b3..a56ebbdd3 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -720,6 +720,18 @@ renderWForm :: (RenderMessage (HandlerSite m) AFormMessage, MonadHandler m) => F
   (Markup -> MForm m (FormResult a, WidgetT (HandlerSite m) IO ()))
 renderWForm formLayout = renderAForm formLayout . wFormToAForm
 
+renderFieldViews :: ( RenderMessage site AFormMessage
+                    , RenderMessage site FormMessage
+                    )
+                 => FormLayout -> [FieldView site] -> WidgetT site IO ()
+renderFieldViews layout
+  = join
+  . fmap (view _1)
+  . generateFormPost
+  . lmap (const mempty)
+  . renderWForm layout
+  . (FormSuccess () <$)
+  . lift . tell
 
 -- | special id to identify form section headers, see 'aformSection' and 'formSection'
 --   currently only treated by form generation through 'renderAForm'
@@ -997,6 +1009,29 @@ mforced Field{..} FieldSettings{..} val = do
            }
          )
 
+mforcedOpt :: MonadHandler m
+           => Field m a
+           -> FieldSettings (HandlerSite m)
+           -> Maybe a
+           -> MForm m (FormResult (Maybe a), FieldView (HandlerSite m))
+mforcedOpt Field{..} FieldSettings{..} mVal = do
+  tell fieldEnctype
+  name <- maybe newFormIdent return fsName
+  theId <- lift $ maybe newIdent return fsId
+  mr <- getMessageRender
+  let fsAttrs' = fsAttrs <> [("disabled", "")]
+  return ( FormSuccess mVal
+         , FieldView
+           { fvLabel = toHtml $ mr fsLabel
+           , fvTooltip = toHtml <$> fmap mr fsTooltip
+           , fvId = theId
+           , fvInput = fieldView theId name fsAttrs' (maybe (Left "") Right mVal) False
+           , fvErrors = Nothing
+           , fvRequired = False
+           }
+         )
+
+
 aforced :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
         => Field m a -> FieldSettings site -> a -> AForm m a
 aforced field settings val = formToAForm $ over _2 pure <$> mforced field settings val
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index 4c015f185..c47836273 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -154,6 +154,8 @@ makePrisms ''AuthenticationMode
 
 makeLenses_ ''CourseUserNote
 
+makeLenses_ ''CourseApplication
+
 
 -- makeClassy_ ''Load
 
diff --git a/templates/allocation/show/course.hamlet b/templates/allocation/show/course.hamlet
index 4714f18b5..146844919 100644
--- a/templates/allocation/show/course.hamlet
+++ b/templates/allocation/show/course.hamlet
@@ -1,8 +1,8 @@
 <div .allocation-course id=#{toPathPiece cID}>
   <div .allocation-course__priority>
-    $if mayApply
-      Prio $# TODO
-    $else
+    $maybe prioView <- mApplyFormView' >>= afvPriority
+      ^{fvInput prioView}
+    $nothing
       _{MsgAllocationNoApplication}
   <a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR}>
     #{courseName}
@@ -14,6 +14,7 @@
         <p>
           <a href=@{CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR}>
             #{iconRegisterTemplate} _{MsgCourseApplicationTemplateApplication}
-  $if mayApply
-    <div .allocation-course__application uw-interactive-fieldset data-conditional-input="" data-conditional-value="" data-conditional-negated>
-      
+  $maybe ApplicationFormView{ ..} <- mApplyFormView'
+    <div .allocation-course__application uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
+      ^{renderFieldViews FormStandard afvForm}
+      ^{snd afvButtons}

From 4dcc82a7709ae4e145a666d170286e3f9f939d41 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 19 Aug 2019 14:54:03 +0200
Subject: [PATCH 4/7] feat(allocations): implement application interface

---
 frontend/src/utils/inputs/inputs.scss   |   6 +-
 messages/uniworx/de.msg                 |  17 +-
 src/Crypto/Hash/Instances.hs            |  22 +++
 src/Database/Esqueleto/Utils.hs         |  35 +++-
 src/Foundation.hs                       |  12 +-
 src/Handler/Admin.hs                    |   2 +-
 src/Handler/Allocation/Application.hs   | 251 ++++++++++++++++++++++--
 src/Handler/Allocation/Show.hs          |  16 +-
 src/Handler/Course/Application.hs       |   4 -
 src/Handler/Course/Register.hs          |  40 ++--
 src/Handler/Sheet.hs                    |   2 +-
 src/Handler/Utils/Table/Columns.hs      |   2 +-
 src/Import/NoModel.hs                   |   1 +
 src/Model/Migration.hs                  |   2 +-
 src/Utils.hs                            |   9 +-
 src/Utils/DB.hs                         |   4 +
 src/Utils/Form.hs                       |  15 +-
 src/Utils/Icon.hs                       |   4 +
 src/Utils/Lens.hs                       |   2 +
 src/Utils/Message.hs                    |   6 +
 templates/allocation/show.hamlet        |  36 ++--
 templates/allocation/show.lucius        |  85 ++++++++
 templates/allocation/show/course.hamlet |  33 ++--
 templates/default-layout.lucius         |  78 ++++++--
 templates/widgets/aform/aform.hamlet    |   3 +
 25 files changed, 577 insertions(+), 110 deletions(-)
 create mode 100644 src/Crypto/Hash/Instances.hs
 create mode 100644 templates/allocation/show.lucius

diff --git a/frontend/src/utils/inputs/inputs.scss b/frontend/src/utils/inputs/inputs.scss
index 643902d08..ae81b82d4 100644
--- a/frontend/src/utils/inputs/inputs.scss
+++ b/frontend/src/utils/inputs/inputs.scss
@@ -9,11 +9,9 @@
   grid-gap: 5px;
   justify-content: flex-start;
   align-items: flex-start;
-  padding: 4px 0;
-  border-left: 2px solid transparent;
 
-  + .form-group {
-    margin-top: 7px;
+  + .form-group, + .form-section-legend, + .form-section-notification {
+    margin-top: 11px;
   }
 
   + .form-section-title {
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 0d12afe08..d43d2c7eb 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -170,6 +170,18 @@ CourseApplicationInstructionsRegistration: Anweisungen zur Anmeldung
 CourseApplicationTemplateApplication: Bewerbungsvorlage(n)
 CourseApplicationTemplateRegistration: Anmeldungsvorlage(n)
 CourseApplicationTemplateArchiveName tid@TermId ssh@SchoolId csh@CourseShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase csh}-bewerbungsvorlagen
+CourseApplication: Bewerbung
+
+CourseApplicationExists: Sie haben sich bereits für diesen Kurs beworben
+CourseApplicationInvalidAction: Angegeben Aktion kann nicht durchgeführt werden
+CourseApplicationCreated csh@CourseShorthand: Erfolgreich zu #{csh} beworben
+CourseApplicationEdited csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich angepasst
+CourseApplicationNotEdited csh@CourseShorthand: Bewerbung zu #{csh} hat sich nicht verändert
+CourseApplicationRated: Bewertung erfolgreich angepasst
+CourseApplicationRatingDeleted: Bewertung erfolgreich entfernt
+CourseApplicationDeleted csh@CourseShorthand: Bewerbung zu #{csh} erfolgreich zurückgezogen
+
+CourseApplicationTitle displayName@Text csh@CourseShorthand: Bewerbung für #{csh}: #{displayName} 
 
 CourseApplicationText: Text-Bewerbung
 CourseApplicationFollowInstructions: Beachten Sie die Anweisungen zur Bewerbung!
@@ -183,6 +195,8 @@ CourseRegistrationFile: Datei zur Anmeldung
 CourseRegistrationFiles: Datei(en) zur Anmeldung
 CourseRegistrationArchive: Zip-Archiv der Datei(en) zur Anmeldung
 CourseApplicationNoFiles: Keine Datei(en)
+CourseApplicationFilesNeedReupload: Bewerbungsdateien müssen neu hochgeladen werden, wann immer die Bewerbung angepasst wird
+CourseRegistrationFilesNeedReupload: Dateien zur Anmeldung müssen neu hochgeladen werden, wann immer die Anmeldung angepasst wird
 
 CourseApplicationDeleteToEdit: Um Ihre Bewerbung zu editieren müssen Sie sie zunächst zurückziehen und sich erneut bewerben.
 CourseRegistrationDeleteToEdit: Um Ihre Anmeldungsdaten zu editieren müssen Sie sich zunächst ab- und dann erneut anmelden.
@@ -372,7 +386,7 @@ MaterialFree: Kursmaterialien ohne Anmeldung zugänglich
 UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung
 UnauthorizedSystemMessageTime: Diese Systemnachricht ist noch nicht oder nicht mehr einsehbar.
 UnauthorizedSystemMessageAuth: Diese Systemnachricht ist nur für angemeldete Benutzer einsehbar.
-UnsupportedAuthPredicate authTagT@Text shownRoute@String: "#{authTagT}" wurde auf eine Route angewandt, die dies nicht unterstützt: #{shownRoute}
+UnsupportedAuthPredicate authTagT@Text shownRoute@Text: „#{authTagT}“ wurde auf eine Route angewandt, die dies nicht unterstützt: „#{shownRoute}“
 UnauthorizedDisabledTag authTag@AuthTag: Authorisierungsprädikat "#{toPathPiece authTag}" ist für Ihre Sitzung nicht aktiv
 UnknownAuthPredicate tag@String: Authorisierungsprädikat "#{tag}" ist dem System nicht bekannt
 UnauthorizedRedirect: Die angeforderte Seite existiert nicht oder Sie haben keine Berechtigung, die angeforderte Seite zu sehen.
@@ -1472,6 +1486,7 @@ AllocationRegistrationEdited: Einstellungen zur Teilnahme an der Zentralanmeldun
 BtnAllocationRegister: Teilnahme registrieren
 BtnAllocationRegistrationEdit: Teilnahme anpassen
 AllocationParticipation: Teilnahme an der Zentralanmeldung
+AllocationParticipationLoginFirst: Um an der Zentralanmeldung teilzunehmen, loggen Sie sich bitte zunächst ein.
 AllocationCourses: Kurse
 AllocationData: Organisatorisches
 AllocationCoursePriority i@Natural: #{i}. Wahl
diff --git a/src/Crypto/Hash/Instances.hs b/src/Crypto/Hash/Instances.hs
new file mode 100644
index 000000000..66228a69e
--- /dev/null
+++ b/src/Crypto/Hash/Instances.hs
@@ -0,0 +1,22 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Crypto.Hash.Instances
+  () where
+
+import ClassyPrelude
+
+import Crypto.Hash
+
+import Database.Persist
+import Database.Persist.Sql
+
+import Data.ByteArray (convert)
+
+
+instance HashAlgorithm hash => PersistField (Digest hash) where
+  toPersistValue = PersistByteString . convert
+  fromPersistValue (PersistByteString bs) = maybe (Left "Could not convert Digest from ByteString") Right $ digestFromByteString bs
+  fromPersistValue _ = Left "Digest values must be converted from PersistByteString"
+
+instance HashAlgorithm hash => PersistFieldSql (Digest hash) where
+  sqlType _ = SqlBlob 
diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs
index 5a032a6de..201091a2d 100644
--- a/src/Database/Esqueleto/Utils.hs
+++ b/src/Database/Esqueleto/Utils.hs
@@ -15,10 +15,13 @@ module Database.Esqueleto.Utils
   , orderByOrd, orderByEnum
   , lower, ciEq
   , selectExists
+  , SqlHashable
+  , sha256
+  , maybe
   ) where
 
 
-import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust)
+import ClassyPrelude.Yesod hiding (isInfixOf, any, all, or, and, isJust, maybe)
 import Data.Universe
 import qualified Data.Set as Set
 import qualified Data.List as List
@@ -27,6 +30,11 @@ import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E
 import Database.Esqueleto.Utils.TH
 
+import qualified Data.Text.Lazy as Lazy (Text)
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+
+import Crypto.Hash (Digest, SHA256)
+
 {-# ANN any ("HLint: ignore Use any" :: String) #-}
 {-# ANN all ("HLint: ignore Use all" :: String) #-}
 
@@ -199,3 +207,28 @@ selectExists query = do
   case res of
     [E.Value b] -> return b
     _other      -> error "SELECT EXISTS ... returned zero or more than one rows"
+
+
+class SqlHashable a
+instance SqlHashable Text
+instance SqlHashable ByteString
+instance SqlHashable Lazy.Text
+instance SqlHashable Lazy.ByteString
+
+
+sha256 :: SqlHashable a => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value (Digest SHA256))
+sha256 = E.unsafeSqlFunction "digest" . (, E.val "sha256" :: E.SqlExpr (E.Value Text))
+
+
+maybe :: (PersistField a, PersistField b)
+      => E.SqlExpr (E.Value b)
+      -> (E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value b))
+      -> E.SqlExpr (E.Value (Maybe a))
+      -> E.SqlExpr (E.Value b)
+maybe onNothing onJust val = E.case_
+  [ E.when_
+      (E.not_ $ E.isNothing val)
+    E.then_
+      (onJust $ E.veryUnsafeCoerceSqlExprValue val)
+  ]
+  (E.else_ onNothing)
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 6b47320ad..68a223a94 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -283,8 +283,12 @@ instance RenderMessage UniWorX MsgLanguage where
     where
       mr = renderMessage foundation ls
 
-instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
-  renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)
+instance RenderMessage UniWorX (UnsupportedAuthPredicate AuthTag (Route UniWorX)) where
+  renderMessage f ls (UnsupportedAuthPredicate tag route) = mr . MsgUnsupportedAuthPredicate (mr tag) $ Text.intercalate "/" pieces
+    where
+      mr :: forall msg. RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage f ls
+      (pieces, _) = renderRoute route
 
 embedRenderMessage ''UniWorX ''MessageStatus ("Message" <>)
 embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
@@ -1189,6 +1193,10 @@ tagAccessPredicate AuthSelf = APDB $ \mAuthId route _ -> exceptT return return $
       appId <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt cID
       CourseApplication{..} <- maybeMExceptT (unauthorizedI MsgUnauthorizedSelf) . $cachedHereBinary appId $ get appId
       return $ Right courseApplicationUser
+    AllocationR _ _ _ (AApplicationR cID) -> do
+      appId <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSelf) (const True :: CryptoIDError -> Bool) $ decrypt cID
+      CourseApplication{..} <- maybeMExceptT (unauthorizedI MsgUnauthorizedSelf) . $cachedHereBinary appId $ get appId
+      return $ Right courseApplicationUser
     _other -> throwError =<< $unsupportedAuthPredicate AuthSelf route
   referencedUser <- case referencedUser' of
     Right uid -> return uid
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 27fc5c809..ded5ebec7 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -21,7 +21,7 @@ import qualified Data.Map as Map
 
 import Database.Persist.Sql (fromSqlKey)
 import qualified Database.Esqueleto as E
-import Database.Esqueleto.Utils as E
+import Database.Esqueleto.Utils (mkExactFilter, mkContainsFilter)
 
 import Handler.Utils.Table.Cells
 import qualified Handler.Utils.TermCandidates as Candidates
diff --git a/src/Handler/Allocation/Application.hs b/src/Handler/Allocation/Application.hs
index 0b970cb0f..cae507c55 100644
--- a/src/Handler/Allocation/Application.hs
+++ b/src/Handler/Allocation/Application.hs
@@ -9,12 +9,23 @@ module Handler.Allocation.Application
   , getAApplicationR, postAApplicationR
   ) where
 
-import Import
+import Import hiding (hash)
 
 import Handler.Utils
 import Utils.Lens
 
 import qualified Data.Text as Text
+import qualified Data.Set as Set
+
+import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils as E
+
+import qualified Data.Conduit.List as C
+
+import Crypto.Hash (hash)
+
+import Control.Monad.Trans.State (execStateT)
+import Control.Monad.State.Class (modify) 
 
 
 data AllocationApplicationButton = BtnAllocationApply
@@ -27,6 +38,7 @@ instance Finite AllocationApplicationButton
 
 nullaryPathPiece ''AllocationApplicationButton $ camelToPathPiece' 1
 embedRenderMessage ''UniWorX ''AllocationApplicationButton id
+makePrisms ''AllocationApplicationButton
 
 instance Button UniWorX AllocationApplicationButton where
   btnClasses BtnAllocationApplicationRetract = [BCIsButton, BCDanger]
@@ -55,6 +67,7 @@ data ApplicationFormMode = ApplicationFormMode
   , afmApplicantEdit :: Bool -- ^ Allow editing text, files, priority (if shown)
   , afmLecturer      :: Bool -- ^ Allow editing rating
   }
+ 
 
 data ApplicationFormException = ApplicationFormNoApplication -- ^ Could not fill forced fields of application form with data from application
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
@@ -63,22 +76,27 @@ instance Exception ApplicationFormException
 applicationForm :: AllocationId
                 -> CourseId
                 -> UserId
-                -> Natural -- ^ Maximum @courseApplicationAllocationPriority@ among all applications
                 -> ApplicationFormMode -- ^ Which parts of the shared form to display
                 -> Html -> MForm Handler (FormResult ApplicationForm, ApplicationFormView)
-applicationForm aId cid uid maxPrio ApplicationFormMode{..} csrf = do
-  (mApp, coursesNum, Course{..}) <- liftHandlerT . runDB $ do
+applicationForm aId cid uid ApplicationFormMode{..} csrf = do
+  (mApp, coursesNum, Course{..}, maxPrio) <- liftHandlerT . runDB $ do
     mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. Just aId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
     coursesNum <- fromIntegral <$> count [AllocationCourseAllocation ==. aId]
     course <- getJust cid
-    return (mApplication, coursesNum, course)
+    [E.Value (fromMaybe 0 -> maxPrio)] <- E.select . E.from $ \courseApplication -> do
+      E.where_ $ courseApplication E.^. CourseApplicationCourse     E.==. E.val cid
+           E.&&. courseApplication E.^. CourseApplicationUser       E.==. E.val uid
+           E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (E.val aId)
+           E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocationPriority)
+      return . E.joinV . E.max_ $ courseApplication E.^. CourseApplicationAllocationPriority
+    return (mApplication, coursesNum, course, maxPrio)
   MsgRenderer mr <- getMsgRenderer
 
   let
     oldPrio :: Maybe Natural
     oldPrio = mApp >>= courseApplicationAllocationPriority . entityVal
 
-    coursesNum' = succ maxPrio `max` pred coursesNum
+    coursesNum' = succ maxPrio `max` coursesNum
 
     mkPrioOption :: Natural -> Option Natural
     mkPrioOption i = Option
@@ -89,7 +107,7 @@ applicationForm aId cid uid maxPrio ApplicationFormMode{..} csrf = do
     
     prioOptions :: OptionList Natural
     prioOptions = OptionList
-      { olOptions = sortOn (Down . optionInternalValue) . map mkPrioOption $ [0 .. coursesNum']
+      { olOptions = sortOn (Down . optionInternalValue) . map mkPrioOption $ [0 .. pred coursesNum']
       , olReadExternal = readMay
       }
     prioField = selectField' (Just $ SomeMessage MsgAllocationCourseNoApplication) $ return prioOptions
@@ -153,6 +171,12 @@ applicationForm aId cid uid maxPrio ApplicationFormMode{..} csrf = do
     | otherwise
       -> return Nothing
 
+  filesWarningView <- if
+    | fromMaybe False hasFiles && isn't _NoUpload courseApplicationsFiles && afmApplicantEdit
+      -> fmap (Just . snd) . formMessage =<< messageIconI Info IconFileUpload MsgCourseApplicationFilesNeedReupload
+    | otherwise
+      -> return Nothing
+
   (filesRes, filesView) <-
     let mkFs = bool MsgCourseApplicationFile MsgCourseApplicationArchive
      in if
@@ -181,10 +205,10 @@ applicationForm aId cid uid maxPrio ApplicationFormMode{..} csrf = do
   
   let
     buttons = catMaybes
-      [ guardOn (not afmApplicantEdit && is _Just    mApp) BtnAllocationApplicationRate
-      , guardOn (    afmApplicantEdit && is _Just    mApp) BtnAllocationApplicationEdit
-      , guardOn (    afmApplicantEdit && is _Nothing mApp) BtnAllocationApply
-      , guardOn (    afmApplicantEdit && is _Just    mApp) BtnAllocationApplicationRetract
+      [ guardOn (not afmApplicantEdit && is _Just    mApp && afmLecturer) BtnAllocationApplicationRate
+      , guardOn (    afmApplicantEdit && is _Just    mApp               ) BtnAllocationApplicationEdit
+      , guardOn (    afmApplicantEdit && is _Nothing mApp               ) BtnAllocationApply
+      , guardOn (    afmApplicantEdit && is _Just    mApp               ) BtnAllocationApplicationRetract
       ]
   (actionRes, buttonsView) <- buttonForm' buttons csrf
 
@@ -203,6 +227,7 @@ applicationForm aId cid uid maxPrio ApplicationFormMode{..} csrf = do
              [ Just fieldView'
              , textView
              , filesLinkView
+             , filesWarningView
              ] ++ maybe [] (map Just) filesView ++
              [ vetoView
              , pointsView
@@ -215,9 +240,205 @@ applicationForm aId cid uid maxPrio ApplicationFormMode{..} csrf = do
  
 
 
-postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
-postAApplyR = fail "Not implemented"
+editApplicationR :: AllocationId
+                 -> UserId
+                 -> CourseId
+                 -> Maybe CourseApplicationId
+                 -> ApplicationFormMode
+                 -> (AllocationApplicationButton -> Bool)
+                 -> SomeRoute UniWorX
+                 -> Handler (ApplicationFormView, Enctype)
+editApplicationR aId uid cid mAppId afMode allowAction postAction = do
+  Course{..} <- runDB $ get404 cid
 
-getAApplicationR, postAApplicationR :: TermId -> SchoolId -> AllocationShorthand -> CryptoFileNameCourseApplication -> Handler Void
+  ((appRes, appView), appEnc) <- runFormPost $ applicationForm aId cid uid afMode
+
+  formResult appRes $ \ApplicationForm{..} -> do
+    if
+      | BtnAllocationApply <- afAction
+      , allowAction afAction
+        -> runDB $ do
+          haveOld <- exists [ CourseApplicationCourse     ==. cid
+                            , CourseApplicationUser       ==. uid
+                            , CourseApplicationAllocation ==. Just aId
+                            ]
+          when haveOld $
+            invalidArgsI [MsgCourseApplicationExists]
+
+          now <- liftIO getCurrentTime
+          let rated = afRatingVeto || is _Just afRatingPoints
+
+          appId <- insert CourseApplication
+            { courseApplicationCourse             = cid
+            , courseApplicationUser               = uid
+            , courseApplicationField              = afField
+            , courseApplicationText               = afText
+            , courseApplicationRatingVeto         = afRatingVeto
+            , courseApplicationRatingPoints       = afRatingPoints
+            , courseApplicationRatingComment      = afRatingComment
+            , courseApplicationAllocation         = Just aId
+            , courseApplicationAllocationPriority = afPriority
+            , courseApplicationTime               = now
+            , courseApplicationRatingTime         = guardOn rated now
+            }
+          let
+            sinkFile' file = do
+              fId <- insert file
+              insert_ $ CourseApplicationFile appId fId
+          forM_ afFiles $ \afFiles' ->
+            runConduit $ transPipe liftHandlerT afFiles' .| C.mapM_ sinkFile'
+          audit $ TransactionCourseApplicationEdit cid uid appId
+          addMessageI Success $ MsgCourseApplicationCreated courseShorthand
+      | is _BtnAllocationApplicationEdit afAction || is _BtnAllocationApplicationRate afAction
+      , allowAction afAction
+      , Just appId <- mAppId
+        -> runDB $ do
+          now <- liftIO getCurrentTime
+
+          changes <- if
+            | afmApplicantEdit afMode -> do
+              oldFiles <- Set.fromList . map (courseApplicationFileFile . entityVal) <$> selectList [CourseApplicationFileApplication ==. appId] []
+              changes <- flip execStateT oldFiles . forM_ afFiles $ \afFiles' ->
+                let sinkFile' file = do
+                      oldFiles' <- lift . E.select . E.from $ \(courseApplicationFile `E.InnerJoin` file') -> do
+                        E.on $ courseApplicationFile E.^. CourseApplicationFileFile E.==. file' E.^. FileId
+                        E.where_ $ file' E.^. FileTitle E.==. E.val (fileTitle file)
+                                E.&&. E.maybe
+                                        (E.val . is _Nothing $ fileContent file)
+                                        (\fc' -> maybe E.false (\fc -> E.sha256 fc' E.==. E.val (hash fc)) $ fileContent file)
+                                        (file' E.^. FileContent)
+                                E.&&. file' E.^. FileId `E.in_` E.valList (Set.toList oldFiles)
+                        return $ file' E.^. FileId
+                      if
+                        | [E.Value oldFileId] <- oldFiles'
+                          -> modify $ Set.delete oldFileId
+                        | otherwise
+                          -> do
+                            fId <- lift $ insert file
+                            lift . insert_ $ CourseApplicationFile appId fId
+                            modify $ Set.insert fId
+                 in runConduit $ transPipe liftHandlerT afFiles' .| C.mapM_ sinkFile'
+              deleteCascadeWhere [ FileId <-. Set.toList (oldFiles `Set.intersection` changes) ]
+              return changes
+            | otherwise
+              -> return Set.empty
+
+          oldApp <- get404 appId
+          let newApp = oldApp
+                { courseApplicationField              = afField
+                , courseApplicationText               = afText
+                , courseApplicationRatingVeto         = afRatingVeto
+                , courseApplicationRatingPoints       = afRatingPoints
+                , courseApplicationRatingComment      = afRatingComment
+                , courseApplicationAllocation         = Just aId
+                , courseApplicationAllocationPriority = afPriority
+                }
+
+              newRating = any (\f -> f oldApp newApp)
+                [ (/=) `on` courseApplicationRatingVeto
+                , (/=) `on` courseApplicationRatingPoints
+                , (/=) `on` courseApplicationRatingComment
+                ]
+              hasRating = any ($ newApp)
+                [ courseApplicationRatingVeto
+                , is _Just . courseApplicationRatingPoints
+                ]
+
+              appChanged = any (\f -> f oldApp newApp)
+                [ (/=) `on` courseApplicationField
+                , (/=) `on` courseApplicationText
+                , \_ _ -> not $ Set.null changes
+                ]
+
+              newApp' = newApp
+                & bool id (set _courseApplicationRatingTime Nothing) appChanged
+                & bool id (set _courseApplicationRatingTime $ Just now) (newRating && hasRating)
+                & bool id (set _courseApplicationTime now) appChanged
+          replace appId newApp'
+          audit $ TransactionCourseApplicationEdit cid uid appId
+
+          uncurry addMessageI =<< case (afmLecturer afMode, newRating, hasRating, appChanged) of
+            (_, False, _, True) -> return (Success, MsgCourseApplicationEdited courseShorthand)
+            (_, False, _, False) -> return (Info, MsgCourseApplicationNotEdited courseShorthand)
+            (True, True, True, _) -> return (Success, MsgCourseApplicationRated)
+            (True, True, False, _) -> return (Success, MsgCourseApplicationRatingDeleted)
+            (False, True, _, _) -> permissionDenied "rating changed without lecturer rights"
+      | is _BtnAllocationApplicationRetract afAction
+      , allowAction afAction
+      , Just appId <- mAppId
+        -> runDB $ do
+          deleteCascade appId
+          audit $ TransactionCourseApplicationDeleted cid uid appId
+          addMessageI Success $ MsgCourseApplicationDeleted courseShorthand
+      | otherwise
+        -> invalidArgsI [MsgCourseApplicationInvalidAction]
+
+    redirect postAction
+
+  return (appView, appEnc)
+        
+
+postAApplyR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDCourse -> Handler Void
+postAApplyR tid ssh ash cID = do
+  uid <- requireAuthId
+  cid <- decrypt cID
+  (aId, Course{..}) <- runDB $ do
+    aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
+    course <- get404 cid
+    return (aId, course)
+
+  afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
+
+  let afMode = ApplicationFormMode
+        { afmApplicant = True
+        , afmApplicantEdit = True
+        , afmLecturer
+        }
+
+  void . editApplicationR aId uid cid Nothing afMode (== BtnAllocationApply) . SomeRoute $ AllocationR tid ssh ash AShowR :#: cID
+
+  invalidArgs ["Application form required"]
+
+
+getAApplicationR, postAApplicationR :: TermId -> SchoolId -> AllocationShorthand -> CryptoFileNameCourseApplication -> Handler Html
 getAApplicationR = postAApplicationR
-postAApplicationR = fail "Not implemented"
+postAApplicationR tid ssh ash cID = do
+  uid <- requireAuthId
+  appId <- decrypt cID
+  (Entity aId Allocation{..}, Entity cid Course{..}, CourseApplication{..}, isAdmin, User{..}) <- runDB $ do
+    alloc <- getBy404 $ TermSchoolAllocationShort tid ssh ash
+    app <- get404 appId
+    Just course <- getEntity $ courseApplicationCourse app
+    Just appUser <- get $ courseApplicationUser app
+    isAdmin <- exists [UserAdminUser ==. uid, UserAdminSchool ==. alloc ^. _entityVal . _allocationSchool]
+    return (alloc, course, app, isAdmin, appUser)
+
+  afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
+  afmApplicantEdit <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplicationR cID
+  courseCID <- encrypt cid :: Handler CryptoUUIDCourse
+
+  let afMode = ApplicationFormMode
+        { afmApplicant = uid == courseApplicationUser || isAdmin
+        , afmApplicantEdit
+        , afmLecturer
+        }
+
+  (ApplicationFormView{..}, appEnc) <- editApplicationR aId uid cid (Just appId) afMode (/= BtnAllocationApply) $ if
+    | uid == courseApplicationUser
+      -> SomeRoute $ AllocationR tid ssh ash AShowR :#: courseCID
+    | otherwise
+      -> SomeRoute . AllocationR tid ssh ash $ AApplicationR cID
+
+  let title = MsgCourseApplicationTitle userDisplayName courseShorthand
+
+  siteLayoutMsg title $ do
+    setTitleI title
+
+    wrapForm ((<> snd afvButtons) . renderFieldViews FormStandard . maybe id (:) afvPriority$ afvForm) FormSettings
+      { formMethod = POST
+      , formAction = Just . SomeRoute . AllocationR tid ssh ash $ AApplicationR cID
+      , formEncoding = appEnc
+      , formAttrs = []
+      , formSubmit = FormNoSubmit
+      , formAnchor = Nothing :: Maybe Text
+      }
diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs
index b386021c3..53149712a 100644
--- a/src/Handler/Allocation/Show.hs
+++ b/src/Handler/Allocation/Show.hs
@@ -60,8 +60,6 @@ getAShowR tid ssh ash = do
       , formSubmit = FormSubmit
       , formAnchor = Nothing :: Maybe Text
       }
-  let
-    maxPrio = maybe 0 maximum . fromNullable $ courses ^.. folded . resultCourseApplication . _entityVal . _courseApplicationAllocationPriority . _Just
 
   siteLayoutMsg title $ do
     setTitleI shortTitle
@@ -73,20 +71,26 @@ getAShowR tid ssh ash = do
           cID <- encrypt cid :: WidgetT UniWorX IO CryptoUUIDCourse
           mayApply <- hasWriteAccessTo . AllocationR tid ssh ash $ AApplyR cID
           isLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
-          mApplyFormView <- liftHandlerT . for muid $ \uid -> generateFormPost . applicationForm aId cid uid maxPrio $ ApplicationFormMode True mayApply isLecturer
+          mApplyFormView <- liftHandlerT . for muid $ \uid -> generateFormPost . applicationForm aId cid uid $ ApplicationFormMode True mayApply isLecturer
           subRoute <- fmap (fromMaybe $ AApplyR cID) . for mApp $ \(Entity appId _) -> AApplicationR <$> encrypt appId
           let mApplyFormView' = view _1 <$> mApplyFormView
+              overrideVisible = not mayApply && is _Just mApp
           case mApplyFormView of
             Just (_, appFormEnctype)
               -> wrapForm $(widgetFile "allocation/show/course") FormSettings
                  { formMethod = POST
                  , formAction = Just . SomeRoute $ AllocationR tid ssh ash subRoute
                  , formEncoding = appFormEnctype
-                 , formAttrs = []
+                 , formAttrs = [ ("class", "allocation-course")
+                               ]
                  , formSubmit = FormNoSubmit
-                 , formAnchor = Nothing :: Maybe Text
+                 , formAnchor = Just cID
                  }
             Nothing
-              -> $(widgetFile "allocation/show/course")
+              -> let wdgt = $(widgetFile "allocation/show/course")
+                  in [whamlet|
+                       <div .allocation-course ##{toPathPiece cID}>
+                         ^{wdgt}
+                     |]
   
     $(widgetFile "allocation/show")
diff --git a/src/Handler/Course/Application.hs b/src/Handler/Course/Application.hs
index f4a1fcada..7bdbb62ba 100644
--- a/src/Handler/Course/Application.hs
+++ b/src/Handler/Course/Application.hs
@@ -25,10 +25,6 @@ getCAFilesR tid ssh csh cID = do
           , ssh == courseSchool
           , csh == courseShorthand
           ]
-    forM_ courseApplicationAllocation $ \aId -> do
-      Allocation{..} <- get404 aId
-      cCourse <- encrypt courseApplicationCourse :: DB CryptoUUIDCourse
-      redirectWith movedPermanently301 $ AllocationR courseTerm courseSchool allocationShorthand AShowR :#: toPathPiece cCourse
     unless matches . redirectWith movedPermanently301 $ CApplicationR courseTerm courseSchool courseShorthand cID CAFilesR
     get404 courseApplicationUser
 
diff --git a/src/Handler/Course/Register.hs b/src/Handler/Course/Register.hs
index 860835bf3..123cc83ad 100644
--- a/src/Handler/Course/Register.hs
+++ b/src/Handler/Course/Register.hs
@@ -114,26 +114,26 @@ courseRegisterForm (Entity cid Course{..}) = liftHandlerT $ do
     let appFilesInfo = (,) <$> hasFiles <*> appCID
         filesMsg = bool MsgCourseRegistrationFiles MsgCourseApplicationFiles courseApplicationsRequired
 
-    if
-      | isn't _NoUpload courseApplicationsFiles || fromMaybe False hasFiles
-        -> let filesLinkField = Field{..}
-                 where
-                   fieldParse _ _ = return $ Right Nothing
-                   fieldEnctype = mempty
-                   fieldView theId _ attrs _ _
-                     = [whamlet|
-                         $newline never
-                           $case appFilesInfo
-                             $of Just (True, appCID)
-                               <a ##{theId} *{attrs} href=@{CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR}>
-                                 _{filesMsg}
-                             $of _
-                               <span ##{theId} *{attrs}>
-                                 _{MsgCourseApplicationNoFiles}
-                       |]
-            in void $ wforced filesLinkField (fslI filesMsg) Nothing
-      | otherwise
-        -> return ()
+    when (isn't _NoUpload courseApplicationsFiles || fromMaybe False hasFiles) $
+      let filesLinkField = Field{..}
+            where
+              fieldParse _ _ = return $ Right Nothing
+              fieldEnctype = mempty
+              fieldView theId _ attrs _ _
+                = [whamlet|
+                    $newline never
+                      $case appFilesInfo
+                        $of Just (True, appCID)
+                          <a ##{theId} *{attrs} href=@{CApplicationR courseTerm courseSchool courseShorthand appCID CAFilesR}>
+                            _{filesMsg}
+                        $of _
+                          <span ##{theId} *{attrs}>
+                            _{MsgCourseApplicationNoFiles}
+                  |]
+       in void $ wforced filesLinkField (fslI filesMsg) Nothing
+
+    when (fromMaybe False hasFiles && isn't _NoUpload courseApplicationsFiles) $
+      wformMessage <=< messageIconI Info IconFileUpload $ bool MsgCourseRegistrationFilesNeedReupload MsgCourseApplicationFilesNeedReupload courseApplicationsRequired
 
     appFilesRes <- let mkFs | courseApplicationsRequired = bool MsgCourseApplicationFile MsgCourseApplicationArchive
                             | otherwise                  = bool MsgCourseRegistrationFile MsgCourseRegistrationArchive
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 4a5cccef9..f1bf685b8 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -726,7 +726,7 @@ correctorForm shid = wFormToAForm $ do
   -- when (not (Map.null loads) && applyDefaultLoads) $       -- Alert Message
   --   addMessageI Warning MsgCorrectorsDefaulted
   when (not (Map.null loads) && applyDefaultLoads) $          -- Alert Notification
-    wformMessage =<< messageI Warning MsgCorrectorsDefaulted
+    wformMessage =<< messageIconI Warning IconNoCorrectors MsgCorrectorsDefaulted
 
 
   let
diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs
index 2f06cd252..a7de88025 100644
--- a/src/Handler/Utils/Table/Columns.hs
+++ b/src/Handler/Utils/Table/Columns.hs
@@ -12,7 +12,7 @@ import Import
 -- import Text.Blaze (ToMarkup(..))
 
 import qualified Database.Esqueleto as E
-import Database.Esqueleto.Utils as E
+import Database.Esqueleto.Utils (mkExactFilter, mkExactFilterWith, mkContainsFilter, mkContainsFilterWith, anyFilter)
 
 import Utils.Lens
 import Handler.Utils
diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs
index e9d357662..3b5894373 100644
--- a/src/Import/NoModel.hs
+++ b/src/Import/NoModel.hs
@@ -113,6 +113,7 @@ import Data.UUID.Instances as Import ()
 import System.FilePath.Instances as Import ()
 import Net.IP.Instances as Import ()
 import Data.Void.Instances as Import ()
+import Crypto.Hash.Instances as Import ()
 
 
 import Control.Monad.Trans.RWS (RWST)
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index 1c9109490..3d2bf8a69 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -127,7 +127,7 @@ requiresMigration = mapReaderT (exceptT return return) $ do
 initialMigration :: Migration
 -- ^ Manual migrations to go to InitialVersion below:
 initialMigration = do
-  migrateEnableExtension "citext"
+  mapM_ migrateEnableExtension ["citext", "pgcrypto"]
   migrateDBVersioning
 
 getMissingMigrations :: forall m m'.
diff --git a/src/Utils.hs b/src/Utils.hs
index db521a099..91a53cdb9 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -105,16 +105,17 @@ guardAuthResult AuthenticationRequired = notAuthenticated
 guardAuthResult (Unauthorized t) = permissionDenied t
 guardAuthResult Authorized = return ()
 
-data UnsupportedAuthPredicate route = UnsupportedAuthPredicate Text route
+data UnsupportedAuthPredicate tag route = UnsupportedAuthPredicate tag route
   deriving (Eq, Ord, Typeable, Show)
-instance (Show route, Typeable route) => Exception (UnsupportedAuthPredicate route)
+instance (Show tag, Typeable tag, Show route, Typeable route) => Exception (UnsupportedAuthPredicate tag route)
 
 unsupportedAuthPredicate :: ExpQ
 unsupportedAuthPredicate = do
   logFunc <- logErrorS
   [e| \tag route -> do
-        $(return logFunc) "AccessControl" [st|"!#{toPathPiece tag}" used on route that doesn't support it: #{tshow route}|]
-        unauthorizedI (UnsupportedAuthPredicate (toPathPiece tag) route)
+        tRoute <- toTextUrl route
+        $(return logFunc) "AccessControl" $ "!" <> toPathPiece tag <> " used on route that doesn't support it: " <> tRoute
+        unauthorizedI (UnsupportedAuthPredicate tag route)
     |]
 
 -- | allows conditional attributes in hamlet via *{..} syntax
diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs
index 3907253cb..326cef129 100644
--- a/src/Utils/DB.hs
+++ b/src/Utils/DB.hs
@@ -48,6 +48,10 @@ existsKey :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity r
           => Key record -> ReaderT backend m Bool
 existsKey = fmap isJust . get -- TODO optimize, so that DB does not deliver entire record
 
+exists :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity record, PersistQueryRead backend, MonadIO m)
+       => [Filter record] -> ReaderT backend m Bool
+exists = fmap (not . null) . flip selectKeysList [LimitTo 1]
+
 updateBy :: (PersistUniqueRead backend, PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend )
          => Unique record -> [Update record] -> ReaderT backend m ()
 updateBy uniq updates = do
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index a56ebbdd3..8a4f951ac 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -808,15 +808,26 @@ wformMessage :: (MonadHandler m) => Message -> WForm m ()
 wformMessage = void . aFormToWForm . aformMessage
 
 formMessage :: (MonadHandler m) => Message -> MForm m (FormResult (), FieldView site)
-formMessage Message{ messageIcon = _, ..} = do -- custom icons are not currently implemented for `.notification`
+formMessage Message{..} = do
   return (FormSuccess (), FieldView
     { fvLabel    = mempty
     , fvTooltip  = Nothing
     , fvId       = idFormMessageNoinput
     , fvErrors   = Nothing
     , fvRequired = False
-    , fvInput    = [whamlet|<div .notification .notification-#{toPathPiece messageStatus}>#{messageContent}|]
+    , fvInput    = [whamlet|
+                     $newline never
+                     <div .notification .notification-#{toPathPiece messageStatus} .fa-#{maybe defaultIcon iconText messageIcon}>
+                       <div .notification__content>
+                         #{messageContent}
+                   |]
     })
+  where
+    defaultIcon = case messageStatus of
+      Success -> "check-circle"
+      Info    -> "info-circle"
+      Warning -> "exclamation-circle"
+      Error   -> "exclamation-triangle"
 
 ---------------------
 -- Form evaluation --
diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs
index a7f6ceeae..30f62a959 100644
--- a/src/Utils/Icon.hs
+++ b/src/Utils/Icon.hs
@@ -47,6 +47,7 @@ data Icon
   | IconCommentFalse
   | IconLink
   | IconFileDownload
+  | IconFileUpload
   | IconFileZip
   | IconFileCSV
   | IconSFTQuestion  -- for SheetFileType only
@@ -57,6 +58,7 @@ data Icon
   | IconRegisterTemplate
   | IconApplyTrue
   | IconApplyFalse
+  | IconNoCorrectors
   deriving (Eq, Ord, Enum, Bounded, Show, Read)
 
 iconText :: Icon -> Text
@@ -78,6 +80,7 @@ iconText = \case
     IconCommentFalse       -> "comment-slash"      -- comment-alt-slash is not available for free
     IconLink               -> "link"
     IconFileDownload       -> "file-download"
+    IconFileUpload         -> "file-upload"
     IconFileZip            -> "file-archive"
     IconFileCSV            -> "file-csv"
     IconSFTQuestion        -> "question-circle"    -- for SheetFileType only, should all be round (similar)
@@ -88,6 +91,7 @@ iconText = \case
     IconRegisterTemplate   -> "file-alt"
     IconApplyTrue          -> "file-alt"
     IconApplyFalse         -> "trash"
+    IconNoCorrectors       -> "user-slash"
 
 instance Universe Icon
 instance Finite   Icon
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index c47836273..2ddabae17 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -155,6 +155,8 @@ makePrisms ''AuthenticationMode
 makeLenses_ ''CourseUserNote
 
 makeLenses_ ''CourseApplication
+  
+makeLenses_ ''Allocation
 
 
 -- makeClassy_ ''Load
diff --git a/src/Utils/Message.hs b/src/Utils/Message.hs
index d72d065bf..908848873 100644
--- a/src/Utils/Message.hs
+++ b/src/Utils/Message.hs
@@ -6,6 +6,7 @@ module Utils.Message
   , addMessage, addMessageI, addMessageIHamlet, addMessageFile, addMessageWidget
   , statusToUrgencyClass
   , Message(..)
+  , messageIconI
   , messageI, messageIHamlet, messageFile, messageWidget
   ) where
 
@@ -140,6 +141,11 @@ messageI messageStatus msg = do
   let messageIcon = Nothing
   return Message{..}
 
+messageIconI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageStatus -> Icon -> msg -> m Message
+messageIconI messageStatus (Just -> messageIcon) msg = do
+  messageContent <- toHtml . ($ msg) <$> getMessageRender
+  return Message{..}
+
 addMessageIHamlet :: ( MonadHandler m
                      , RenderMessage (HandlerSite m) msg
                      , HandlerSite m ~ site
diff --git a/templates/allocation/show.hamlet b/templates/allocation/show.hamlet
index 74711e783..d2406a677 100644
--- a/templates/allocation/show.hamlet
+++ b/templates/allocation/show.hamlet
@@ -34,28 +34,34 @@ $newline never
         <dd .deflist__dd>
           ^{formatTimeRangeW SelFormatDateTime fromT allocationStaffAllocationTo}
 
-$if mayRegister || is _Just registration
+$if is _Just muid
+  $if mayRegister || is _Just registration
+    <section id=allocation-participation>
+      <h2>
+        _{MsgAllocationParticipation}
+      $if mayRegister
+        ^{registerForm'}
+      $else
+        $maybe Entity _ AllocationUser{allocationUserTotalCourses} <- registration
+          <dl .deflist>
+            <dt .deflist__dt>
+              _{MsgAllocationTotalCourses}
+            <dd .deflist__dd>
+              #{allocationUserTotalCourses}
+$else
   <section id=allocation-participation>
     <h2>
       _{MsgAllocationParticipation}
-    $if mayRegister
-      ^{registerForm'}
-    $else
-      $maybe Entity _ AllocationUser{allocationUserTotalCourses} <- registration
-        <dl .deflist>
-          <dt .deflist__dt>
-            _{MsgAllocationTotalCourses}
-          <dd .deflist__dd>
-            #{allocationUserTotalCourses}
+    <p>
+      _{MsgAllocationParticipationLoginFirst}
 
 $if not (null courseWidgets)
   <section .allocation>
     <h2>
       _{MsgAllocationCourses}
-    <div .allocation__explanation>
+    <div .allocation__explanation .allocation__label>
       <p>_{MsgAllocationPriorityTip}
       <p>_{MsgAllocationPriorityRelative}
-    <div .allocation__priority-label>
-      _{MsgAllocationPriority}
-    $forall courseWgt <- courseWidgets
-      ^{courseWgt}
+    <div .allocation__courses>
+      $forall courseWgt <- courseWidgets
+        ^{courseWgt}
diff --git a/templates/allocation/show.lucius b/templates/allocation/show.lucius
new file mode 100644
index 000000000..7e2e4f406
--- /dev/null
+++ b/templates/allocation/show.lucius
@@ -0,0 +1,85 @@
+.allocation__label {
+  color: var(--color-fontsec);
+  font-style: italic;
+}
+
+.allocation__courses {
+  margin-top: 20px;
+}
+
+.allocation-course {
+  display: grid;
+  grid-template-columns: 140px 1fr;
+  grid-template-areas:
+    '.           name   '
+    'prio-label  prio   '
+    'instr-label instr  '
+    'form-label  form   ';
+
+  grid-gap: 5px 7px;
+  padding: 12px 10px;
+
+  &:last-child {
+    padding: 12px 10px 0 10px;
+  }
+
+  & + .allocation-course {
+    border-top: 1px solid var(--color-grey);
+  }
+
+
+  .allocation-course__priority {
+    grid-area: prio;
+  }
+  .allocation-course__priority-label {
+    grid-area: prio-label;
+    justify-self: end;
+    align-self: center;
+    text-align: right;
+  }
+
+  .allocation-course__name {
+    grid-area: name;
+
+    align-self: center;
+
+    font-size: 1.2rem;
+  }
+
+  .allocation-course__instructions {
+    grid-area: instr;
+  }
+  .allocation-course__instructions-label {
+    grid-area: instr-label;
+    justify-self: end;
+    text-align: right;
+  }
+
+  .allocation-course__application {
+    grid-area: form;
+  }
+  .allocation-course__application-label {
+    grid-area: form-label;
+    justify-self: end;
+    text-align: right;
+    padding-top: 6px;
+  }
+}
+
+@media (max-width: 426px) {
+  .allocation-course {
+    grid-template-columns: 1fr;
+    grid-template-areas:
+      'name       '
+      'prio-label '
+      'prio       '
+      'instr-label'
+      'instr      '
+      'form-label '
+      'form       ';
+  }
+  
+  .allocation-course__application-label {
+    padding-top: 0;
+  }
+}
diff --git a/templates/allocation/show/course.hamlet b/templates/allocation/show/course.hamlet
index 146844919..53992eed4 100644
--- a/templates/allocation/show/course.hamlet
+++ b/templates/allocation/show/course.hamlet
@@ -1,20 +1,27 @@
-<div .allocation-course id=#{toPathPiece cID}>
+$if is _Just muid
+  <div .allocation-course__priority-label .allocation__label>
+    _{MsgAllocationPriority}
   <div .allocation-course__priority>
     $maybe prioView <- mApplyFormView' >>= afvPriority
       ^{fvInput prioView}
     $nothing
       _{MsgAllocationNoApplication}
-  <a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR}>
-    #{courseName}
-  $maybe aInst <- courseApplicationsInstructions
-    <div .allocation-course__instructions>
+<a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR} target="_blank">
+  #{courseName}
+$if hasApplicationTemplate || is _Just courseApplicationsInstructions
+  <div .allocation-course__instructions-label .allocation__label>
+    _{MsgCourseApplicationInstructionsApplication}
+  <div .allocation-course__instructions>
+    $maybe aInst <- courseApplicationsInstructions
       <p>
         #{aInst}
-      $if hasApplicationTemplate
-        <p>
-          <a href=@{CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR}>
-            #{iconRegisterTemplate} _{MsgCourseApplicationTemplateApplication}
-  $maybe ApplicationFormView{ ..} <- mApplyFormView'
-    <div .allocation-course__application uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
-      ^{renderFieldViews FormStandard afvForm}
-      ^{snd afvButtons}
+    $if hasApplicationTemplate
+      <p>
+        <a href=@{CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR}>
+          #{iconRegisterTemplate} _{MsgCourseApplicationTemplateApplication}
+$maybe ApplicationFormView{ ..} <- mApplyFormView'
+  <div .allocation-course__application-label .allocation__label :not overrideVisible:uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
+    _{MsgCourseApplication}
+  <div .allocation-course__application :not overrideVisible:uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
+    ^{renderFieldViews FormStandard afvForm}
+    ^{snd afvButtons}
diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius
index b1db5eea7..f929425ec 100644
--- a/templates/default-layout.lucius
+++ b/templates/default-layout.lucius
@@ -180,11 +180,15 @@ h4 {
   }
 
   p {
-    margin: 10px 0;
-  }
+    margin: 0.5rem 0;
 
-  p:last-child {
-    margin: 10px 0 0;
+    &:last-child {
+      margin: 0.5rem 0 0;
+    }
+
+    &:first-of-type {
+      margin: 0;
+    }
   }
 }
 
@@ -546,6 +550,7 @@ section {
 
     &:last-child {
         border-bottom: none;
+        padding-bottom: 0px;
     }
 }
 
@@ -564,33 +569,64 @@ section {
   border-radius: 3px;
   padding: 10px 20px 20px;
   margin: 40px 0;
-  color: var(--color-dark);
   box-shadow: 0 0 4px 2px inset currentColor;
-  padding-left: 20%;
+  padding-left: 100px;
   min-height: 100px;
+  max-width: 700px;
+  font-weight: 600;
+  vertical-align: center;
+  display: grid;
+  grid-column: 2;
 
   &::before {
-    content: 'i';
+    font-family: "Font Awesome 5 Free";
+    font-weight: 900;
     position: absolute;
     display: flex;
     left: 0;
     top: 0;
     height: 100%;
-    width: 20%;
-    font-size: 100px;
+    width: 100px;
+    font-size: 50px;
     align-items: center;
     justify-content: center;
   }
+
+  .notification__content {
+    grid-column: 1;
+    align-self: center;
+  }
 }
 
-.form-group__input > .notification {
-  margin: 0;
+.form-section-notification {
+  display: grid;
+  grid-template-columns: 1fr 3fr;
+  grid-gap: 5px;
+
+  .notification {
+    margin: 0;
+  }
+
+  + .form-group, + .form-section-legend, + .form-section-notification {
+    margin-top: 11px;
+  }
+
+  + .form-section-title {
+    margin-top: 40px;
+  }
 }
 
 @media (max-width: 768px) {
+  .form-section-notification {
+    grid-template-columns: 1fr;
+    margin-top: 17px;
+  }
 
   .notification {
+    grid-column: 1;
 
+    max-width: none;
+      
     padding-left: 40px;
 
     &::before {
@@ -602,16 +638,20 @@ section {
   }
 }
 
-.notification-danger {
-  color: #c51919 ;
-
-  &::before {
-    content: '!';
-  }
+.notification-error {
+  color: var(--color-error) ;
 }
 
-.notification__content {
-  color: var(--color-font);
+.notification-warning {
+  color: var(--color-warning) ;
+}
+
+.notification-info {
+  color: var(--color-lightblack) ;
+}
+
+.notification-success {
+  color: var(--color-warning) ;
 }
 
 
diff --git a/templates/widgets/aform/aform.hamlet b/templates/widgets/aform/aform.hamlet
index c0bd83e13..844821fa2 100644
--- a/templates/widgets/aform/aform.hamlet
+++ b/templates/widgets/aform/aform.hamlet
@@ -11,6 +11,9 @@ $case formLayout
       $if fvId view == idFormSectionNoinput
         <h3 .form-section-title>
           ^{fvLabel view}
+      $elseif fvId view == idFormMessageNoinput
+        <div .form-section-notification>
+          ^{fvInput view}
       $else
         <div .form-group .interactive-fieldset__target :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
           $if not (Blaze.null $ fvLabel view)

From c759364ab1d43a4e796cd92a494cafb939dd2568 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 19 Aug 2019 15:55:33 +0200
Subject: [PATCH 5/7] feat(allocations): link allocations from home

---
 messages/uniworx/de.msg                |  9 +++-
 src/Handler/Home.hs                    | 66 +++++++++++++++++++++++++-
 templates/home/openAllocations.hamlet  |  4 ++
 templates/i18n/changelog/de.hamlet     | 10 ++++
 templates/i18n/info-lecturer/de.hamlet | 27 ++++-------
 5 files changed, 96 insertions(+), 20 deletions(-)
 create mode 100644 templates/home/openAllocations.hamlet

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index d43d2c7eb..c4862d134 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -127,7 +127,7 @@ CourseShorthand: Kürzel
 CourseShorthandUnique: Muss innerhalb Institut und Semester eindeutig sein
 CourseSemester: Semester
 CourseSchool: Institut
-CourseSchoolShort: Fach
+CourseSchoolShort: Institut
 CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
 CourseSecretFormat: beliebige Zeichenkette
 CourseRegisterFromTip: Ohne Datum ist KEINE eigenständige Anmeldung von Studierenden möglich
@@ -451,6 +451,7 @@ TokensLastReset: Tokens zuletzt invalidiert
 TokensResetSuccess: Authorisierungs-Tokens invalidiert
 
 HomeOpenCourses: Kurse mit offener Registrierung
+HomeOpenAllocations: Offene Zentralanmeldungen
 HomeUpcomingSheets: Anstehende Übungsblätter
 HomeUpcomingExams: Bevorstehende Prüfungen
 
@@ -1502,4 +1503,8 @@ ApplicationRatingPoints: Bewertung
 ApplicationRatingPointsTip: Bewerber mit 5.0 werden garantiert nicht dem Kurs zugeteilt
 ApplicationRatingComment: Kommentar
 ApplicationRatingCommentVisibleTip: Feedback an den Bewerbers
-ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursverwalter
\ No newline at end of file
+ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursverwalter
+
+AllocationSchoolShort: Institut
+Allocation: Zentralanmeldung
+AllocationRegisterTo: Anmeldungen bis
\ No newline at end of file
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index b4d16ff10..51e9975a5 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -20,9 +20,65 @@ getHomeR = do
     setTitleI MsgHomeHeading
     fromMaybe mempty upcomingExamsWidget
     maybe mempty homeUpcomingSheets muid
+    homeOpenAllocations
     homeOpenCourses
 
 
+homeOpenAllocations :: Widget
+homeOpenAllocations = do
+  cTime <- liftIO getCurrentTime
+  let tableData :: E.SqlExpr (Entity Allocation)
+                  -> E.SqlQuery (E.SqlExpr (Entity Allocation))
+      tableData allocation = do
+        E.where_ $ E.maybe E.false (\rf -> rf E.<=. E.val cTime) (allocation E.^. AllocationRegisterFrom)
+             E.&&. E.maybe E.true  (\rt -> rt E.>=. E.val cTime) (allocation E.^. AllocationRegisterTo)
+        return allocation
+
+      colonnade :: Colonnade Sortable (DBRow (Entity Allocation)) (DBCell (HandlerT UniWorX IO) ())
+      colonnade = mconcat
+        [ -- dbRow
+          sortable (Just "term")   (i18nCell MsgTerm)
+            $ \DBRow{ dbrOutput=Entity{entityVal = Allocation{..}} } ->
+              anchorCell (TermCourseListR allocationTerm) [whamlet|#{allocationTerm}|]
+        , sortable (Just "schoolshort") (i18nCell MsgAllocationSchoolShort)
+            $ \DBRow{ dbrOutput=(Entity _ Allocation{..}) } ->
+              anchorCell (TermSchoolCourseListR allocationTerm allocationSchool) [whamlet|_{unSchoolKey allocationSchool}|]
+        , sortable (Just "allocation") (i18nCell MsgAllocation) $ \DBRow{ dbrOutput=Entity{entityVal = Allocation{..}} } -> do
+            anchorCell (AllocationR allocationTerm allocationSchool allocationShorthand AShowR) allocationName
+        , sortable (Just "deadline") (i18nCell MsgAllocationRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = Allocation{..}} } ->
+            cell $ traverse (formatTime SelFormatDateTime) allocationRegisterTo >>= maybe mempty toWidget
+        ]
+      validator = def & defaultSorting [SortAscBy "deadline", SortAscBy "allocation"]
+  allocationTable <- liftHandlerT . runDB $ dbTableWidget' validator DBTable
+    { dbtSQLQuery  = tableData
+    , dbtRowKey    = (E.^. AllocationId)
+    , dbtColonnade = colonnade
+    , dbtProj      = return
+    , dbtSorting   = Map.fromList
+                      [ ( "term"
+                        , SortColumn $ \allocation -> allocation E.^. AllocationTerm
+                        )
+                      , ( "schoolshort"
+                        , SortColumn $ \allocation -> allocation E.^. AllocationSchool
+                        )
+                      , ( "allocation"
+                        , SortColumn $ \allocation -> allocation E.^. AllocationShorthand
+                        )
+                      , ( "deadline"
+                        , SortColumn $ \allocation -> allocation E.^. AllocationRegisterTo
+                        )
+                      ]
+    , dbtFilter    =  mempty
+    , dbtFilterUI  = mempty
+    , dbtStyle     = def
+    , dbtParams    = def
+    , dbtIdent     = "open-allocations" :: Text
+    , dbtCsvEncode = noCsvEncode
+    , dbtCsvDecode = Nothing
+    }
+  $(widgetFile "home/openAllocations")
+
+
 homeOpenCourses :: Widget
 homeOpenCourses = do
   cTime <- liftIO getCurrentTime
@@ -34,6 +90,13 @@ homeOpenCourses = do
                 E.&&. (       E.isNothing (course E.^. CourseRegisterTo)
                         E.||. course E.^. CourseRegisterTo E.>=. E.val (Just cTime)
                       )
+                E.&&. E.not_ (E.exists . E.from $ \(allocation `E.InnerJoin` allocationCourse) -> do
+                                 E.on $ allocation E.^. AllocationId E.==. allocationCourse E.^. AllocationCourseAllocation
+                                 E.where_ $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+                                 E.where_ $ E.maybe E.true  (\rf -> rf E.>. E.val cTime) (allocation E.^. AllocationRegisterFrom)
+                                      E.||. E.maybe E.false (\rt -> rt E.<. E.val cTime) (allocation E.^. AllocationRegisterTo)
+                                 E.where_ $ E.maybe E.true  (\rf -> rf E.>. E.val cTime) (allocation E.^. AllocationRegisterByCourse)
+                             )
             return course
 
       colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
@@ -53,7 +116,8 @@ homeOpenCourses = do
         , sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
             cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
         ]
-  courseTable <- liftHandlerT . runDB $ dbTableWidget' def DBTable
+      validator = def & defaultSorting [SortAscBy "deadline", SortAscBy "course"]
+  courseTable <- liftHandlerT . runDB $ dbTableWidget' validator DBTable
     { dbtSQLQuery  = tableData
     , dbtRowKey    = (E.^. CourseId)
     , dbtColonnade = colonnade
diff --git a/templates/home/openAllocations.hamlet b/templates/home/openAllocations.hamlet
new file mode 100644
index 000000000..16c84d41a
--- /dev/null
+++ b/templates/home/openAllocations.hamlet
@@ -0,0 +1,4 @@
+$newline never
+<section>
+  <h2>_{MsgHomeOpenAllocations}
+  ^{allocationTable}
diff --git a/templates/i18n/changelog/de.hamlet b/templates/i18n/changelog/de.hamlet
index d32d6a27c..d2c436d00 100644
--- a/templates/i18n/changelog/de.hamlet
+++ b/templates/i18n/changelog/de.hamlet
@@ -1,5 +1,15 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>19.08.2019
+  <dd .deflist__dd>
+    <ul>
+      <li>Bewerbungen für Zentralanmeldungen
+  
+  <dt .deflist__dt>12.08.2019
+  <dd .deflist__dd>
+    <ul>
+      <li>Kurse zu Zentralanmeldungen eintragen
+  
   <dt .deflist__dt>23.07.2019
   <dd .deflist__dd>
     <ul>
diff --git a/templates/i18n/info-lecturer/de.hamlet b/templates/i18n/info-lecturer/de.hamlet
index 68038e828..86b7794ab 100644
--- a/templates/i18n/info-lecturer/de.hamlet
+++ b/templates/i18n/info-lecturer/de.hamlet
@@ -12,8 +12,6 @@ $newline text
       <p>
         Veranstalter können eigene Veranstaltungen zu verschiedenen Zentralanmeldungen hinzufügen.
         Dies findet man unter dem Menupunkt "Kurs editieren"
-      <p>
-        Die Zentralanmeldungen selbst sind momentan aber noch nicht sichtbar; dies folgt in Kürze.
       <p>
         Weitere Details finden sich weiter unter auf dieser Seite in einem
         <a href="#allocations">
@@ -32,16 +30,6 @@ $newline text
           eigenem Abschnitt
         \ detailliert.
 
-
-    <dt .deflist__dt>Benachrichtigungen
-    <dd .deflist__dd>
-      Benachrichtigungen werden momentan oft mit großer Verzögerung versandt.
-      Die Ursache ist derzeit noch unbekannt, da das Problem noch nicht genauer untersucht werden konnte.
-
-    $#
-    $# MOVE ITEM TO SECTION "VERANSTALTUNGEN", once it is implemented:
-    $#
-
 <section>
   <h2>Veranstaltungen
 
@@ -365,16 +353,21 @@ $newline text
       Veranstaltungen können einen beliebigen Namen tragen.
       Die behelfsmäßigen Kürzel wie [SB], [ZP], usw sind nicht mehr notwendig!
 
-    <dt .deflist__dt> Kurseinstellung
+    <dt .deflist__dt> Kurseinstellungen
     <dd .deflist__dd>
-      Die Kurseinstellungen werden ggf. von den notwendigen Einstellungen
-      der jeweiligen Zentralanmeldung überschrieben, d.h. Veranstalter
-      können hier keine Fehler mehr machen.
+      <p>
+        Die Kurseinstellungen werden ggf. von den notwendigen Einstellungen
+        der jeweiligen Zentralanmeldung überschrieben, d.h. Veranstalter
+        können hier keine Fehler mehr machen.
+      <p>
+        Insbesondere wird auch der eingestellte Anmeldungszeitraum ignoriert und
+        die direkte Anmeldung von Studierenden zum Kurs (auch durch die
+        Kursverwalter) unterbunden, bis die zentrale Platzvergabe erfolgt ist.
 
     <dt .deflist__dt> Individuelle Bewerbungen
     <dd .deflist__dd>
       Studierende können nun pro Kurs eine individuelle Bewerbung abgeben,
-      welche nur den jeweiligen Kursverwaltern zugestelt wird.
+      welche nur den jeweiligen Kursverwaltern zugestellt wird.
 
 
     <dt .deflist__dt> Feedback zu Bewerbungen

From 81a534139c894e7398d71976b5489735aa6843c8 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 19 Aug 2019 16:21:32 +0200
Subject: [PATCH 6/7] chore(tests): fix tests

---
 src/Foundation.hs                  | 1 +
 src/Handler/Allocation/Register.hs | 2 ++
 test/FoundationSpec.hs             | 4 ++++
 3 files changed, 7 insertions(+)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 68a223a94..a80f277d6 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -152,6 +152,7 @@ deriving instance Generic MaterialR
 deriving instance Generic TutorialR
 deriving instance Generic ExamR
 deriving instance Generic CourseApplicationR
+deriving instance Generic AllocationR
 deriving instance Generic (Route UniWorX)
 
 -- | Convenient Type Synonyms:
diff --git a/src/Handler/Allocation/Register.hs b/src/Handler/Allocation/Register.hs
index 0c19a866d..9c2256695 100644
--- a/src/Handler/Allocation/Register.hs
+++ b/src/Handler/Allocation/Register.hs
@@ -12,6 +12,8 @@ import Utils.Lens
 
 import Handler.Utils.Form
 
+{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}
+
 
 data AllocationRegisterForm = AllocationRegisterForm
   { arfTotalCourses :: Natural
diff --git a/test/FoundationSpec.hs b/test/FoundationSpec.hs
index cc562d816..d84e2ee7d 100644
--- a/test/FoundationSpec.hs
+++ b/test/FoundationSpec.hs
@@ -52,6 +52,10 @@ instance Arbitrary CourseApplicationR where
   arbitrary = genericArbitrary
   shrink = genericShrink
 
+instance Arbitrary AllocationR where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
 instance Arbitrary (Route UniWorX) where
   arbitrary = genericArbitrary
   shrink = genericShrink

From 440f0a97d0b5540ce537237bbb7c4bba22514079 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Mon, 19 Aug 2019 16:23:32 +0200
Subject: [PATCH 7/7] chore(release): 5.1.0

---
 CHANGELOG.md      | 13 +++++++++++++
 package-lock.json |  2 +-
 package.json      |  2 +-
 package.yaml      |  2 +-
 4 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8755e90b0..dadeb24b1 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,19 @@
 
 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.
 
+## [5.1.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.0.2...v5.1.0) (2019-08-19)
+
+
+### Features
+
+* **allocations:** add application form(s) ([ef625cd](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/ef625cd))
+* **allocations:** add registration form ([c5b18fc](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c5b18fc))
+* **allocations:** implement application interface ([4dcc82a](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/4dcc82a))
+* **allocations:** link allocations from home ([c759364](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c759364))
+* **allocations:** set up routes ([c2df01c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/c2df01c))
+
+
+
 ### [5.0.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v5.0.1...v5.0.2) (2019-08-13)
 
 
diff --git a/package-lock.json b/package-lock.json
index f27cdab3d..c0d813997 100644
--- a/package-lock.json
+++ b/package-lock.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "5.0.2",
+  "version": "5.1.0",
   "lockfileVersion": 1,
   "requires": true,
   "dependencies": {
diff --git a/package.json b/package.json
index 8914b3650..6795c3884 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "uni2work",
-  "version": "5.0.2",
+  "version": "5.1.0",
   "description": "",
   "keywords": [],
   "author": "",
diff --git a/package.yaml b/package.yaml
index 53e8c4d5e..1d62936ac 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:    uniworx
-version: 5.0.2
+version: 5.1.0
 
 dependencies:
   # Due to a bug in GHC 8.0.1, we block its usage