Minor commenting
This commit is contained in:
parent
4383f46409
commit
c5beac0eb1
@ -511,95 +511,6 @@ instance Yesod UniWorX where
|
||||
makeLogger = return . appLogger
|
||||
|
||||
|
||||
{- ALL DEPRECATED and will be deleted, once knownTags is completed
|
||||
|
||||
isAuthorizedDB :: Route UniWorX -> Bool -> YesodDB UniWorX AuthResult
|
||||
isAuthorizedDB route@(routeAttrs -> attrs) writeable
|
||||
| "adminAny" `member` attrs = adminAccess Nothing
|
||||
| "lecturerAny" `member` attrs = lecturerAccess Nothing
|
||||
|
||||
isAuthorizedDB UsersR _ = adminAccess Nothing
|
||||
isAuthorizedDB (SubmissionDemoR cID) _ = return Authorized -- submissionAccess $ Right cID
|
||||
isAuthorizedDB (SubmissionDownloadSingleR cID _) _ = submissionAccess $ Right cID
|
||||
isAuthorizedDB (SubmissionDownloadArchiveR (ZIPArchiveName cID)) _ = submissionAccess $ Left cID
|
||||
isAuthorizedDB TermEditR _ = adminAccess Nothing
|
||||
isAuthorizedDB (TermEditExistR _) _ = adminAccess Nothing
|
||||
isAuthorizedDB CourseNewR _ = lecturerAccess Nothing
|
||||
isAuthorizedDB (CourseR t c CEditR) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
|
||||
isAuthorizedDB (CourseR t c (SheetR SheetListR)) False = return Authorized --
|
||||
isAuthorizedDB (CourseR t c (SheetR SheetListR)) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
|
||||
isAuthorizedDB (CourseR t c (SheetR (SShowR s))) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor
|
||||
isAuthorizedDB (CourseR t c (SheetR (SheetFileR s _ _))) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor
|
||||
isAuthorizedDB (CourseR t c (SheetR SheetNewR)) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
|
||||
isAuthorizedDB (CourseR t c (SheetR (SEditR s))) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
|
||||
isAuthorizedDB (CourseR t c (SheetR (SDelR s))) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c)
|
||||
isAuthorizedDB (CourseR t c (SheetR (SubmissionR s m))) _ = return Authorized -- TODO -- submissionAccess $ Right cID
|
||||
isAuthorizedDB (CourseEditIDR cID) _ = do
|
||||
courseId <- decrypt cID
|
||||
courseLecturerAccess courseId
|
||||
isAuthorizedDB _route _isWrite = return $ Unauthorized "No access to this route." -- Calling isAuthorized here creates infinite loop!
|
||||
|
||||
submissionAccess :: Either CryptoFileNameSubmission CryptoUUIDSubmission -> YesodDB UniWorX AuthResult
|
||||
submissionAccess cID = do
|
||||
authId <- lift requireAuthId
|
||||
submissionId <- either decrypt decrypt cID
|
||||
Submission{..} <- get404 submissionId
|
||||
submissionUsers <- map (submissionUserUser . entityVal) <$> selectList [SubmissionUserSubmission ==. submissionId] []
|
||||
let auth = authId `elem` submissionUsers || Just authId == submissionRatingBy
|
||||
return $ case auth of
|
||||
True -> Authorized
|
||||
False -> Unauthorized "No access to this submission"
|
||||
|
||||
adminAccess :: Maybe SchoolId -- ^ If @Just@, matched exactly against 'userAdminSchool'
|
||||
-> YesodDB UniWorX AuthResult
|
||||
adminAccess school = do
|
||||
authId <- lift requireAuthId
|
||||
adrights <- selectList ((UserAdminUser ==. authId) : maybe [] (\s -> [UserAdminSchool ==. s]) school) []
|
||||
return $ if (not $ null adrights)
|
||||
then Authorized
|
||||
else Unauthorized "No admin access" -- TODO internationalize
|
||||
|
||||
lecturerAccess :: Maybe SchoolId
|
||||
-> YesodDB UniWorX AuthResult
|
||||
lecturerAccess school = do
|
||||
authId <- lift requireAuthId
|
||||
lecrights <- selectList ((UserLecturerUser ==. authId) : maybe [] (\s -> [UserLecturerSchool ==. s]) school) []
|
||||
return $ if (not $ null lecrights)
|
||||
then Authorized
|
||||
else Unauthorized "No lecturer access" -- TODO internationalize
|
||||
|
||||
lecturerAccess' :: SchoolId -> YesodDB UniWorX AuthResult
|
||||
lecturerAccess' = authorizedFor UniqueSchoolLecturer MsgUnauthorizedSchoolLecturer
|
||||
|
||||
courseLecturerAccess :: CourseId -> YesodDB UniWorX AuthResult
|
||||
courseLecturerAccess = authorizedFor UniqueLecturer MsgUnauthorizedLecturer
|
||||
|
||||
--courseCorrectorAccess :: CourseId -> YesodDB UniWorX AuthResult
|
||||
--courseCorrectorAccess = authorizedFor UniqueCorrector MsgUnauthorizedCorrector
|
||||
-- TODO: Correctors are no longer unit, could be ByTutorial and also by ByProportion
|
||||
|
||||
courseParticipantAccess :: CourseId -> YesodDB UniWorX AuthResult
|
||||
courseParticipantAccess = authorizedFor UniqueParticipant MsgUnauthorizedParticipant
|
||||
|
||||
authorizedFor :: ( PersistEntityBackend record ~ BaseBackend backend
|
||||
, PersistEntity record, PersistUniqueRead backend
|
||||
, YesodAuth master, RenderMessage master msg
|
||||
)
|
||||
=> (AuthId master -> t -> Unique record) -> msg -> t -> ReaderT backend (HandlerT master IO) AuthResult
|
||||
authorizedFor authType msg courseId = do
|
||||
authId <- lift requireAuthId
|
||||
access <- getBy $ authType authId courseId
|
||||
case access of
|
||||
(Just _) -> return Authorized
|
||||
Nothing -> unauthorizedI msg
|
||||
|
||||
isAuthorizedDB' :: Route UniWorX -> Bool -> YesodDB UniWorX Bool
|
||||
isAuthorizedDB' route isWrite = (== Authorized) <$> isAuthorizedDB route isWrite
|
||||
|
||||
isAuthorized' :: Route UniWorX -> Bool -> Handler Bool
|
||||
isAuthorized' route isWrite = runDB $ isAuthorizedDB' route isWrite
|
||||
-}
|
||||
|
||||
|
||||
-- Define breadcrumbs.
|
||||
instance YesodBreadcrumbs UniWorX where
|
||||
|
||||
Loading…
Reference in New Issue
Block a user