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

All routes with CryptoIds are verified now, see #233

Browse Source
This commit is contained in:
SJost 2018-11-13 16:03:13 +01:00
parent dc4f37c921
commit 94ee06d3c7
2 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Foundation.hs
View File

@ -1427,6 +1427,7 @@ routeNormalizers =
, ncSchool , ncSchool
, ncCourse , ncCourse
, ncSheet , ncSheet
, verifySubmission
] ]
where where
normalizeRender route = route <$ do normalizeRender route = route <$ do
@ -1464,6 +1465,15 @@ routeNormalizers =
Entity _ Sheet{..} <- MaybeT . lift . getBy $ CourseSheet cid shn Entity _ Sheet{..} <- MaybeT . lift . getBy $ CourseSheet cid shn
hasChanged shn sheetName hasChanged shn sheetName
return $ CSheetR tid ssh csh sheetName subRoute return $ CSheetR tid ssh csh sheetName subRoute
verifySubmission = maybeOrig $ \route -> do
CSubmissionR _tid _ssh _csh _shn cID sr <- return route
sId <- decrypt cID
Submission{submissionSheet} <- lift . lift $ get404 sId
Sheet{sheetCourse, sheetName} <- lift . lift $ get404 submissionSheet
Course{courseTerm, courseSchool, courseShorthand} <- lift . lift $ get404 sheetCourse
let newRoute = CSubmissionR courseTerm courseSchool courseShorthand sheetName cID sr
tell . Any $ route /= newRoute
return newRoute
-- How to run database actions. -- How to run database actions.

7
src/Handler/Corrections.hs
View File

@ -788,13 +788,6 @@ postSAssignR tid ssh csh shn cID = do
sId <- decrypt cID sId <- decrypt cID
(currentCorrector, sheetCorrectors) <- runDB $ do (currentCorrector, sheetCorrectors) <- runDB $ do
Submission{submissionRatingBy, submissionSheet} <- get404 sId Submission{submissionRatingBy, submissionSheet} <- get404 sId
-- Beginn Verify that CryptoId matches ordinary prameters, see #233
-- Necessarry, since authorisation checks those parameters only, but can be changed by user!
Sheet{sheetCourse, sheetName} <- get404 submissionSheet
Course{courseTerm, courseSchool, courseShorthand} <- get404 sheetCourse
let cidMatches = and [tid==courseTerm, ssh==courseSchool, csh==courseShorthand, shn==sheetName]
unless cidMatches $ invalidArgsI [MsgErrorCryptoIdMismatch] -- maybe remove message if refactored
-- End Verification
sheetCorrectors <- map (sheetCorrectorUser . entityVal) <$> selectList [SheetCorrectorSheet ==. submissionSheet] [] sheetCorrectors <- map (sheetCorrectorUser . entityVal) <$> selectList [SheetCorrectorSheet ==. submissionSheet] []
userCorrector <- traverse getJustEntity submissionRatingBy userCorrector <- traverse getJustEntity submissionRatingBy
return (userCorrector, maybe id (:) submissionRatingBy sheetCorrectors) return (userCorrector, maybe id (:) submissionRatingBy sheetCorrectors)