56 lines
2.3 KiB
Haskell
56 lines
2.3 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 [UserFunctionUser ==. uid, UserFunctionSchool ==. alloc ^. _entityVal . _allocationSchool, UserFunctionFunction ==. SchoolAdmin]
|
|
Nothing -> exists [UserFunctionUser ==. uid, UserFunctionSchool ==. course ^. _entityVal . _courseSchool, UserFunctionFunction ==. SchoolAdmin]
|
|
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
|
|
}
|