fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(allocations): don't show all allocation information to lecturers

Browse Source
This commit is contained in:
Gregor Kleen 2019-09-05 10:40:47 +02:00
parent 912afba075
commit ad6c503ef5
2 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Handler/Course/Application/Edit.hs
View File

@ -25,13 +25,14 @@ postCAEditR tid ssh csh cID = do
-> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR -> hasWriteAccessTo $ SchoolR allocationSchool SchoolEditR
Nothing Nothing
-> hasWriteAccessTo $ SchoolR courseSchool SchoolEditR -> hasWriteAccessTo $ SchoolR courseSchool SchoolEditR
let afmApplicant = uid == courseApplicationUser || isAdmin
afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR afmLecturer <- hasWriteAccessTo $ CourseR courseTerm courseSchool courseShorthand CEditR
afmApplicantEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR -- TODO: Wrong. mayEdit <- hasWriteAccessTo $ CApplicationR tid ssh csh cID CAEditR
courseCID <- encrypt cid :: Handler CryptoUUIDCourse courseCID <- encrypt cid :: Handler CryptoUUIDCourse
let afMode = ApplicationFormMode let afMode = ApplicationFormMode
{ afmApplicant = uid == courseApplicationUser || isAdmin { afmApplicant
, afmApplicantEdit , afmApplicantEdit = afmApplicant && mayEdit
, afmLecturer , afmLecturer
} }

7
src/Handler/Course/Application/List.hs
View File

@ -221,6 +221,11 @@ postCApplicationsR tid ssh csh = do
participantLink uid = do participantLink uid = do
cID <- encrypt uid cID <- encrypt uid
return . SomeRoute . CourseR tid ssh csh $ CUserR cID return . SomeRoute . CourseR tid ssh csh $ CUserR cID
applicationLink :: MonadCrypto m => CourseApplicationId -> m (SomeRoute UniWorX)
applicationLink appId = do
cID <- encrypt appId
return . SomeRoute $ CApplicationR tid ssh csh cID CAEditR
dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _ dbtSQLQuery :: CourseApplicationsTableExpr -> E.SqlQuery _
dbtSQLQuery = runReaderT $ do dbtSQLQuery = runReaderT $ do
@ -256,7 +261,7 @@ postCApplicationsR tid ssh csh = do
dbtColonnade :: Colonnade Sortable _ _ dbtColonnade :: Colonnade Sortable _ _
dbtColonnade = mconcat dbtColonnade = mconcat
[ emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand) [ emptyOpticColonnade (resultAllocation . _entityVal) $ \l -> anchorColonnade (views l allocationLink) $ colAllocationShorthand (l . _allocationShorthand)
, colApplicationId (resultCourseApplication . _entityKey) , anchorColonnadeM (views (resultCourseApplication . _entityKey) applicationLink) $ colApplicationId (resultCourseApplication . _entityKey)
, anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) , anchorColonnadeM (views (resultUser . _entityKey) participantLink) $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
, colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
, emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms , emptyOpticColonnade (resultStudyTerms . _entityVal) colStudyTerms