diff --git a/src/Foundation.hs b/src/Foundation.hs index b2f2c7eb2..f60a47238 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -78,6 +78,8 @@ data UniWorX = UniWorX -- type Widget = WidgetT UniWorX IO () mkYesodData "UniWorX" $(parseRoutesFile "routes") +type DB a = YesodDB UniWorX a + data MenuItem = MenuItem { menuItemLabel :: Text , menuItemRoute :: Route UniWorX @@ -236,7 +238,7 @@ lecturerAccess :: Maybe SchoolId -> YesodDB UniWorX AuthResult lecturerAccess school = do authId <- lift requireAuthId - lecrights <- selectList ((UserLecturerUser ==. authId) : maybe [] (\s -> [UserLecturerSchool ==. s]) school) [] + lecrights <- selectList ((UserLecturerUser ==. authId) : maybe [] (\s -> [UserLecturerSchool ==. s]) school) [] return $ if (not $ null lecrights) then Authorized else Unauthorized "No lecturer access" @@ -244,10 +246,28 @@ lecturerAccess school = do courseLecturerAccess :: CourseId -> YesodDB UniWorX AuthResult courseLecturerAccess courseId = do authId <- lift requireAuthId - users <- map (lecturerUserId . entityVal ) <$> selectList [ LecturerCourseId ==. courseId ] [] - return $ case authId `elem` users of - True -> Authorized - False -> Unauthorized "No lecturer access for this course" + lecturer <- getBy $ UniqueLecturer authId courseId + return $ case lecturer of + (Just _) -> Authorized + Nothing -> Unauthorized "Not a lecturer for this course" + +courseCorrectorAccess :: CourseId -> YesodDB UniWorX AuthResult +courseCorrectorAccess courseId = do + authId <- lift requireAuthId + participation <- getBy $ UniqueCorrector authId courseId + return $ case participation of + (Just _) -> Authorized + Nothing -> Unauthorized "Not a corrector for this course" + +courseParticipantAccess :: CourseId -> YesodDB UniWorX AuthResult +courseParticipantAccess courseId = do + authId <- lift requireAuthId + participation <- getBy $ UniqueCourseParticipant courseId authId + return $ case participation of + (Just _) -> Authorized + Nothing -> Unauthorized "Not a participant for this course" + + isAuthorizedDB' :: Route UniWorX -> Bool -> YesodDB UniWorX Bool isAuthorizedDB' route isWrite = (== Authorized) <$> isAuthorizedDB route isWrite diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 5b7bdc2c4..c1839eb0f 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -137,17 +137,25 @@ getSheetList courseEnt = do submissions <- count sheetsub rated <- count $ (SubmissionRatingTime !=. Nothing):sheetsub return (sid, sheet, (submissions, rated)) - let colSheets = mconcat + let colBase = mconcat [ headed "Blatt" $ \(sid,sheet,_) -> linkButton (toWgt $ sheetName sheet) BCLink $ SheetShowR tid csh (sheetName sheet) , headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3 , headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3 , headed "Bewertung" $ toWgt . show . sheetType . snd3 , headed "Korrigiert" $ toWgt . snd . trd3 , headed "Eingereicht" $ toWgt . fst . trd3 - -- TODO: only show edit button for allowed course assistants - , headed "" $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ sheetName $ snd3 s + ] + let colAdmin = mconcat -- only show edit button for allowed course assistants + [ headed "" $ \s -> linkButton "Edit" BCLink $ SheetEditR tid csh $ sheetName $ snd3 s , headed "" $ \s -> linkButton "Delete" BCLink $ SheetDelR tid csh $ sheetName $ snd3 s ] + showAdmin <- case sheets of + ((_,firstSheet,_):_) -> + (Authorized ==) <$> isAuthorized (SheetEditR tid csh $ sheetName firstSheet) False + _otherwise -> return False + let colSheets = if showAdmin + then colBase `mappend` colAdmin + else colBase let pageActions = [ NavbarLeft $ MenuItem { menuItemLabel = "Neues Übungsblatt" diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index e1e0670e0..245d33076 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -201,43 +201,7 @@ buttonForm csrf = do accResult' FormMissing _ = FormMissing accResult' (FormFailure errs) _ = FormFailure errs - ---------------------------------------- --- Buttons (old version, deprecated) -- ---------------------------------------- -formBtnSave :: (Text,Text,Text) -formBtnSave = ("save" ,"Speichern" ,"btn-primary") - -formBtnAbort :: (Text,Text,Text) -formBtnAbort = ("abort" ,"Abbrechen" ,"btn-default") - -formBtnDelete ::(Text,Text,Text) -formBtnDelete = ("delete","Löschen" ,"btn-warning") - -formActionSave :: Maybe Text -formActionSave = Just $ fst3 formBtnSave - -formActionAbort :: Maybe Text -formActionAbort = Just $ fst3 formBtnAbort - -formActionDelete :: Maybe Text -formActionDelete = Just $ fst3 formBtnDelete - -defaultFormActions :: [(Text,Text,Text)] -defaultFormActions = [ formBtnDelete - , formBtnAbort - , formBtnSave - ] - --- Post-Buttons -postButtonForm :: Text -> Form () -postButtonForm lblId = identifyForm lblId buttonF - where - buttonF = renderAForm FormStandard $ pure () <* bootstrapSubmit bProps - bProps :: BootstrapSubmit Text - bProps = fromString $ unpack lblId - ------------ -- Fields --