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

56 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{..}, 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
}