feat: allow editing of course applications outside of allocation

2019-08-26 10:02:18 +02:00 · 2019-08-26 10:02:18 +02:00 · e816a30b35
commit e816a30b35
parent 5e393c53c6
10 changed files with 155 additions and 110 deletions
--- a/frontend/src/utils/inputs/inputs.scss
+++ b/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;
--- a/messages/uniworx/de.msg
+++ b/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
--- a/4
+++ b/4
@ -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
--- a/src/Foundation.hs
+++ b/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
@ -872,6 +842,23 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
                guard $ NTop (Just now) >= NTop deregUntil
            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
@ -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)
--- a/src/Handler/Allocation/Application.hs
+++ b/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]
-    coursesNum <- fromIntegral <$> count [AllocationCourseAllocation ==. aId]
+    mApplication <- listToMaybe <$> selectList [CourseApplicationAllocation ==. maId, CourseApplicationUser ==. uid, CourseApplicationCourse ==. cid] [LimitTo 1]
+    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
-    (True , True , Nothing)
+  (prioRes, prioView) <- case (isAlloc, afmApplicant, afmApplicantEdit, mApp) of
+    (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
-      }
--- a/src/Handler/Allocation/Show.hs
+++ b/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
-          subRoute <- fmap (fromMaybe $ AApplyR cID) . for mApp $ \(Entity appId _) -> AApplicationR <$> encrypt appId
+          mApplyFormView <- liftHandlerT . for muid $ \uid -> generateFormPost . applicationForm (Just aId) cid uid $ ApplicationFormMode True mayApply isLecturer
+          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")
                               ]
--- a/src/Handler/Course/Application.hs
+++ b/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
--- a/src/Handler/Course/Application/Edit.hs
+++ b/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
+      }
--- a/src/Handler/Course/Application/List.hs
+++ b/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

--- 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}
+        $maybe hint <- fvTooltip view
+          <div .form-section-title__hint>
+            ^{hint}
      $elseif fvId view == idFormMessageNoinput
        <div .form-section-notification>
          ^{fvInput view}