This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Course/Application/Edit.hs

59 lines
2.2 KiB
Haskell

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{..}, User{..}) <- runDB $ do
course <- getBy404 $ TermSchoolCourseShort tid ssh csh
app <- get404 appId
mAlloc <- traverse getEntity404 $ courseApplicationAllocation app
appUser <- get404 $ courseApplicationUser app
return (mAlloc, course, app, appUser)
isAdmin <- case mAlloc of
Just (Entity _ Allocation{..})
-> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR
Nothing
-> hasWriteAccessTo $ SchoolR courseSchool SchoolEditR
let afmApplicant = uid == courseApplicationUser || isAdmin
afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
mayEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR
courseCID <- encrypt cid :: Handler CryptoUUIDCourse
let afMode = ApplicationFormMode
{ afmApplicant
, afmApplicantEdit = afmApplicant && mayEdit
, afmLecturer
}
(ApplicationFormView{..}, appEnc) <- editApplicationR (entityKey <$> mAlloc) courseApplicationUser 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
}