feat: allow editing of course applications outside of allocation

frontend/src/utils/inputs/inputs.scss

@@ -1,6 +1,15 @@
 /* GENERAL STYLES FOR FORMS */
 
 /* FORM GROUPS */
+.form-section-title {
+  color: var(--color-fontsec);
+  margin: 0;
+
+  + .form-group {
+      margin-top: 11px;
+  }
+}
+
 .form-group {
   position: relative;
   display: flex;
@@ -19,15 +28,22 @@
   }
 }
 
-.form-section-title {
-  color: var(--color-fontsec);
-}
-
 .form-section-legend {
   color: var(--color-fontsec);
   margin: 7px 0;
 }
 
+.form-section-title__hint {
+  margin-top: 7px;
+  color: var(--color-fontsec);
+  font-size: 0.9rem;
+  font-weight: 600;
+
+  + .form-group {
+    margin-top: 11px;
+  }
+}
+
 .form-group-label {
   font-weight: 600;
   padding-top: 6px;

messages/uniworx/de.msg

@@ -1523,6 +1523,8 @@ ApplicationRatingPointsTip: Bewerber mit 5.0 werden garantiert nicht dem Kurs zu
 ApplicationRatingComment: Kommentar
 ApplicationRatingCommentVisibleTip: Feedback an den Bewerbers
 ApplicationRatingCommentInvisibleTip: Dient zunächst nur als Notiz für Kursverwalter
+ApplicationRatingSection: Bewertung
+ApplicationRatingSectionSelfTip: Sie verfügen über hinreichende Authorisierung um sowohl die Bewerbung als auch ihre Bewertung zu editieren.
 
 AllocationSchoolShort: Institut
 Allocation: Zentralanmeldung

routes

@@ -86,7 +86,6 @@
   /                                              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
@@ -165,7 +164,8 @@
   /apps                         CApplicationsR GET POST
   !/apps/files                  CAppsFilesR    GET
   /apps/#CryptoFileNameCourseApplication CourseApplicationR:
-    /files                      CAFilesR       GET             !self !lecturerANDtime
+    /                           CAEditR        GET POST        !timeANDself !lecturerANDstaff-time !selfANDread
+    /files                      CAFilesR       GET             !self !lecturerANDstaff-time
 
 /subs          CorrectionsR          GET POST !corrector !lecturer
 /subs/upload   CorrectionsUploadR    GET POST !corrector !lecturer

src/Foundation.hs

@@ -665,22 +665,6 @@ 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 (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
-      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
@@ -750,20 +734,6 @@ tagAccessPredicate AuthTutor = APDB $ \mAuthId route _ -> exceptT return return
       guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedTutor)
       return Authorized
 tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
-  CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
-    course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
-    allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
-    allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
-
-    case allocation of
-      Nothing -> return ()
-      Just Allocation{..} -> do
-        cTime <- liftIO getCurrentTime
-        guard $ NTop allocationStaffAllocationFrom <= NTop (Just cTime)
-        guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
-
-    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
@@ -873,6 +843,23 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
             return Authorized
       _other -> unauthorizedI MsgUnauthorizedCourseTime
   
+  CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
+    Entity course Course{..} <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
+    allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
+    allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
+
+    case allocation of
+      Nothing -> do
+        cTime <- liftIO getCurrentTime
+        guard $ maybe False (cTime >=) courseRegisterFrom
+        guard $ maybe True  (cTime <=) courseRegisterTo
+      Just Allocation{..} -> do
+        cTime <- liftIO getCurrentTime
+        guard $ NTop allocationRegisterFrom <= NTop (Just cTime)
+        guard $ NTop (Just cTime) <= NTop allocationRegisterTo
+
+    return Authorized
+
   AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
     -- Checks `registerFrom` and `registerTo`, override as further routes become available
     now <- liftIO getCurrentTime
@@ -891,6 +878,20 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
 
   r -> $unsupportedAuthPredicate AuthTime r
 tagAccessPredicate AuthStaffTime = APDB $ \_ route _ -> case route of
+  CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
+    course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
+    allocationCourse <- $cachedHereBinary course . lift . getBy $ UniqueAllocationCourse course
+    allocation <- for allocationCourse $ \(Entity _ AllocationCourse{..}) -> $cachedHereBinary allocationCourseAllocation . MaybeT $ get allocationCourseAllocation
+
+    case allocation of
+      Nothing -> return ()
+      Just Allocation{..} -> do
+        cTime <- liftIO getCurrentTime
+        guard $ NTop allocationStaffAllocationFrom <= NTop (Just cTime)
+        guard $ NTop (Just cTime) <= NTop allocationStaffAllocationTo
+
+    return Authorized
+
   AllocationR tid ssh ash _ -> maybeT (unauthorizedI MsgUnauthorizedAllocationRegisterTime) $ do
     -- Checks `registerFrom` and `registerTo`, override as further routes become available
     now <- liftIO getCurrentTime
@@ -1203,10 +1204,6 @@ 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
@@ -1757,7 +1754,6 @@ 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 $ AllocationListR)
-  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)
@@ -1783,6 +1779,8 @@ instance YesodBreadcrumbs UniWorX where
 
   breadcrumb (CourseR tid ssh csh CApplicationsR) = return ("Bewerbungen", Just $ CourseR tid ssh csh CShowR)
 
+  breadcrumb (CApplicationR tid ssh csh _ CAEditR) = return ("Bewerbung", Just $ CourseR tid ssh csh CApplicationsR)
+
   breadcrumb (CExamR tid ssh csh examn EShowR) = return (original examn, Just $ CourseR tid ssh csh CExamListR)
   breadcrumb (CExamR tid ssh csh examn EEditR) = return ("Bearbeiten", Just $ CExamR tid ssh csh examn EShowR)
   breadcrumb (CExamR tid ssh csh examn EUsersR) = return ("Teilnehmer", Just $ CExamR tid ssh csh examn EShowR)

src/Handler/Allocation/Application.hs

@@ -4,9 +4,8 @@ module Handler.Allocation.Application
   , ApplicationForm(..)
   , ApplicationFormMode(..)
   , ApplicationFormException(..)
-  , applicationForm
+  , applicationForm, editApplicationR
   , postAApplyR
-  , getAApplicationR, postAApplicationR
   ) where
 
 import Import hiding (hash)
@@ -71,20 +70,21 @@ data ApplicationFormException = ApplicationFormNoApplication -- ^ Could not fill
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 instance Exception ApplicationFormException
 
-applicationForm :: AllocationId
+applicationForm :: (Maybe AllocationId)
                 -> CourseId
                 -> UserId
                 -> ApplicationFormMode -- ^ Which parts of the shared form to display
                 -> Html -> MForm Handler (FormResult ApplicationForm, ApplicationFormView)
-applicationForm aId cid uid ApplicationFormMode{..} csrf = do
+applicationForm maId@(is _Just -> isAlloc) cid uid ApplicationFormMode{..} csrf = do
+  
   (mApp, coursesNum, Course{..}, maxPrio) <- liftHandlerT . runDB $ do
-    mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. Just aId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
+    mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. maId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
-    coursesNum <- fromIntegral <$> count [AllocationCourseAllocation ==. aId]
+    coursesNum <- fromIntegral . fromMaybe 1 <$> for maId (\aId -> count [AllocationCourseAllocation ==. aId])
     course <- getJust cid
     [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.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.val maId
            E.&&. E.not_ (E.isNothing $ courseApplication E.^. CourseApplicationAllocationPriority)
       return . E.joinV . E.max_ $ courseApplication E.^. CourseApplicationAllocationPriority
     return (mApplication, coursesNum, course, maxPrio)
@@ -110,18 +110,20 @@ applicationForm aId cid uid ApplicationFormMode{..} csrf = do
       }
     prioField = selectField' (Just $ SomeMessage MsgAllocationCourseNoApplication) $ return prioOptions
       
-  (prioRes, prioView) <- case (afmApplicant, afmApplicantEdit, mApp) of
+  (prioRes, prioView) <- case (isAlloc, afmApplicant, afmApplicantEdit, mApp) of
-    (True , True , Nothing)
+    (True , True , True , Nothing)
       -> over _2 Just <$> mopt prioField (fslI MsgApplicationPriority) (Just $ oldPrio) 
-    (True , True , Just _ )
+    (True , True , True , Just _ )
       -> over (_1 . _FormSuccess) Just . over _2 Just <$> mreq prioField (fslI MsgApplicationPriority) oldPrio
-    (True , False, _      )
+    (True , True , False, _      )
       -> over _2 Just <$> mforcedOpt prioField (fslI MsgApplicationPriority) oldPrio 
-    (False, _   , Just _ )
+    (True , False, _    , Just _ )
       | is _Just oldPrio
         -> pure (FormSuccess oldPrio, Nothing)
-    _other
+    (True , _    , _    , _      )
       -> throwM ApplicationFormNoApplication
+    (False, _    , _    , _      )
+      -> pure (FormSuccess Nothing, Nothing)
 
   (fieldRes, fieldView') <- if
     | afmApplicantEdit || afmLecturer
@@ -210,6 +212,15 @@ applicationForm aId cid uid ApplicationFormMode{..} csrf = do
       ]
   (actionRes, buttonsView) <- buttonForm' buttons csrf
 
+  ratingSection <- if
+    | afmLecturer
+    , afmApplicantEdit
+      -> Just . set _fvTooltip (Just . toHtml $ mr MsgApplicationRatingSectionSelfTip) . snd <$> formSection MsgApplicationRatingSection
+    | afmLecturer
+      -> Just . snd <$> formSection MsgApplicationRatingSection
+    | otherwise
+      -> return Nothing
+
   return ( ApplicationForm
            <$> prioRes
            <*> fieldRes
@@ -227,7 +238,8 @@ applicationForm aId cid uid ApplicationFormMode{..} csrf = do
              , filesLinkView
              , filesWarningView
              ] ++ maybe [] (map Just) filesView ++
-             [ vetoView
+             [ ratingSection
+             , vetoView
              , pointsView
              , commentView
              ]
@@ -238,7 +250,7 @@ applicationForm aId cid uid ApplicationFormMode{..} csrf = do
  
 
 
-editApplicationR :: AllocationId
+editApplicationR :: Maybe AllocationId
                  -> UserId
                  -> CourseId
                  -> Maybe CourseApplicationId
@@ -246,10 +258,10 @@ editApplicationR :: AllocationId
                  -> (AllocationApplicationButton -> Bool)
                  -> SomeRoute UniWorX
                  -> Handler (ApplicationFormView, Enctype)
-editApplicationR aId uid cid mAppId afMode allowAction postAction = do
+editApplicationR maId uid cid mAppId afMode allowAction postAction = do
   Course{..} <- runDB $ get404 cid
 
-  ((appRes, appView), appEnc) <- runFormPost $ applicationForm aId cid uid afMode
+  ((appRes, appView), appEnc) <- runFormPost $ applicationForm maId cid uid afMode
 
   formResult appRes $ \ApplicationForm{..} -> do
     if
@@ -258,7 +270,7 @@ editApplicationR aId uid cid mAppId afMode allowAction postAction = do
         -> runDB $ do
           haveOld <- exists [ CourseApplicationCourse     ==. cid
                             , CourseApplicationUser       ==. uid
-                            , CourseApplicationAllocation ==. Just aId
+                            , CourseApplicationAllocation ==. maId
                             ]
           when haveOld $
             invalidArgsI [MsgCourseApplicationExists]
@@ -274,7 +286,7 @@ editApplicationR aId uid cid mAppId afMode allowAction postAction = do
             , courseApplicationRatingVeto         = afRatingVeto
             , courseApplicationRatingPoints       = afRatingPoints
             , courseApplicationRatingComment      = afRatingComment
-            , courseApplicationAllocation         = Just aId
+            , courseApplicationAllocation         = maId
             , courseApplicationAllocationPriority = afPriority
             , courseApplicationTime               = now
             , courseApplicationRatingTime         = guardOn rated now
@@ -328,7 +340,7 @@ editApplicationR aId uid cid mAppId afMode allowAction postAction = do
                 , courseApplicationRatingVeto         = afRatingVeto
                 , courseApplicationRatingPoints       = afRatingPoints
                 , courseApplicationRatingComment      = afRatingComment
-                , courseApplicationAllocation         = Just aId
+                , courseApplicationAllocation         = maId
                 , courseApplicationAllocationPriority = afPriority
                 }
 
@@ -393,50 +405,6 @@ postAApplyR tid ssh ash cID = do
         , afmLecturer
         }
 
-  void . editApplicationR aId uid cid Nothing afMode (== BtnAllocationApply) . SomeRoute $ AllocationR tid ssh ash AShowR :#: cID
+  void . editApplicationR (Just 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 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
-      }

src/Handler/Allocation/Show.hs

@@ -71,15 +71,17 @@ 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 $ ApplicationFormMode True mayApply isLecturer
+          mApplyFormView <- liftHandlerT . for muid $ \uid -> generateFormPost . applicationForm (Just aId) cid uid $ ApplicationFormMode True mayApply isLecturer
-          subRoute <- fmap (fromMaybe $ AApplyR cID) . for mApp $ \(Entity appId _) -> AApplicationR <$> encrypt appId
+          tRoute <- case mApp of
+            Nothing -> return . AllocationR tid ssh ash $ AApplyR cID
+            Just (Entity appId _) -> CApplicationR courseTerm courseSchool courseShorthand <$> encrypt appId <*> pure CAEditR
           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
+                 , formAction = Just $ SomeRoute tRoute
                  , formEncoding = appFormEnctype
                  , formAttrs = [ ("class", "allocation-course")
                                ]

src/Handler/Course/Application.hs

@@ -4,3 +4,4 @@ module Handler.Course.Application
 
 import Handler.Course.Application.List  as Handler.Course.Application
 import Handler.Course.Application.Files as Handler.Course.Application
+import Handler.Course.Application.Edit as Handler.Course.Application

src/Handler/Course/Application/Edit.hs

@@ -0,0 +1,55 @@
+module Handler.Course.Application.Edit
+  ( getCAEditR, postCAEditR
+  ) where
+
+import Import
+
+import Handler.Utils
+import Handler.Allocation.Application
+
+
+getCAEditR, postCAEditR :: TermId -> SchoolId -> CourseShorthand -> CryptoFileNameCourseApplication -> Handler Html
+getCAEditR = postCAEditR
+postCAEditR tid ssh csh cID = do
+  uid <- requireAuthId
+  appId <- decrypt cID
+  (mAlloc, Entity cid Course{..}, CourseApplication{..}, isAdmin, User{..}) <- runDB $ do
+    course <- getBy404 $ TermSchoolCourseShort tid ssh csh
+    app <- get404 appId
+    mAlloc <- traverse getEntity404 $ courseApplicationAllocation app
+    appUser <- get404 $ courseApplicationUser app
+    isAdmin <- case mAlloc of
+      Just alloc -> exists [UserAdminUser ==. uid, UserAdminSchool ==. alloc ^. _entityVal . _allocationSchool]
+      Nothing    -> exists [UserAdminUser ==. uid, UserAdminSchool ==. course ^. _entityVal . _courseSchool]
+    return (mAlloc, course, app, isAdmin, appUser)
+
+  afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
+  afmApplicantEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR
+  courseCID <- encrypt cid :: Handler CryptoUUIDCourse
+
+  let afMode = ApplicationFormMode
+        { afmApplicant = uid == courseApplicationUser || isAdmin
+        , afmApplicantEdit
+        , afmLecturer
+        }
+
+  (ApplicationFormView{..}, appEnc) <- editApplicationR (entityKey <$> mAlloc) uid cid (Just appId) afMode (/= BtnAllocationApply) $ if
+    | uid == courseApplicationUser
+    , Just (Entity _ Allocation{..}) <- mAlloc
+      -> SomeRoute $ AllocationR allocationTerm allocationSchool allocationShorthand AShowR :#: courseCID
+    | otherwise
+      -> SomeRoute $ CApplicationR tid ssh csh cID CAEditR
+
+  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 $ CApplicationR tid ssh csh cID CAEditR
+      , formEncoding = appEnc
+      , formAttrs = []
+      , formSubmit = FormNoSubmit
+      , formAnchor = Nothing :: Maybe Text
+      }

src/Handler/Course/Application/List.hs

@@ -116,7 +116,7 @@ postCApplicationsR tid ssh csh = do
         appId <- view $ resultCourseApplication . _entityKey
         cID <- encrypt appId
         
-        guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAFilesR -- TODO: replace with CAShowR
+        guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
 
         view id
 

templates/widgets/aform/aform.hamlet

@@ -11,6 +11,9 @@ $case formLayout
       $if fvId view == idFormSectionNoinput
         <h3 .form-section-title>
           ^{fvLabel view}
+        $maybe hint <- fvTooltip view
+          <div .form-section-title__hint>
+            ^{hint}
       $elseif fvId view == idFormMessageNoinput
         <div .form-section-notification>
           ^{fvInput view}