diff --git a/frontend/src/utils/inputs/inputs.scss b/frontend/src/utils/inputs/inputs.scss index ae81b82d4..c4cb63373 100644 --- 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; diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index e61f792a6..abd555853 100644 --- 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 diff --git a/routes b/routes index d801d285c..b8c14a9e7 100644 --- a/routes +++ b/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 diff --git a/src/Foundation.hs b/src/Foundation.hs index 2d79722e1..5077ef4a5 100644 --- 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) diff --git a/src/Handler/Allocation/Application.hs b/src/Handler/Allocation/Application.hs index 2cf732df8..bc19f3dc2 100644 --- 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 - } diff --git a/src/Handler/Allocation/Show.hs b/src/Handler/Allocation/Show.hs index 0cc4d455b..b31ae9273 100644 --- 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") ] diff --git a/src/Handler/Course/Application.hs b/src/Handler/Course/Application.hs index bcb5146a1..d22c299cc 100644 --- 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 diff --git a/src/Handler/Course/Application/Edit.hs b/src/Handler/Course/Application/Edit.hs new file mode 100644 index 000000000..281a21826 --- /dev/null +++ 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 + } diff --git a/src/Handler/Course/Application/List.hs b/src/Handler/Course/Application/List.hs index 966e29a44..84867c817 100644 --- 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 diff --git a/templates/widgets/aform/aform.hamlet b/templates/widgets/aform/aform.hamlet index 844821fa2..c492b61d7 100644 --- a/templates/widgets/aform/aform.hamlet +++ b/templates/widgets/aform/aform.hamlet @@ -11,6 +11,9 @@ $case formLayout $if fvId view == idFormSectionNoinput

^{fvLabel view} + $maybe hint <- fvTooltip view +
+ ^{hint} $elseif fvId view == idFormMessageNoinput
^{fvInput view}