convenience functions for authorisation, not yet used

messages/de.msg

@@ -15,4 +15,8 @@ SheetNameDup       tid@TermIdentifier courseShortHand@Text sheetName@Text: Es gi
 SheetDelTitle      tid@TermIdentifier courseShortHand@Text sheetName@Text: Übungsblatt #{sheetName} wirklich aus Kurs #{termToText tid}-#{courseShortHand} herauslöschen?
 SheetDelText       submissionNo@Int: Dies kann nicht mehr rückgängig gemacht werden! Alle Einreichungen gehen ebenfalls verloren! Es gibt #{show submissionNo} Abgaben.
 SheetDelOk         tid@TermIdentifier courseShortHand@Text sheetName@Text: #{termToText tid}-#{courseShortHand}: Übungsblatt #{sheetName} gelöscht.
-
+UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut eingetragen.
+UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen.
+UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen.
+UnauthorizedCorrector: Sie sind nicht als Korrektor für diese Veranstaltung eingetragen.
+UnauthorizedParticipant: Sie sind nicht als Teilnehmer für diese Veranstaltung registriert.

models

@@ -11,7 +11,7 @@ UserAdmin
 UserLecturer
     user   UserId
     school SchoolId
-    UniqueSchoolLecturer school user
+    UniqueSchoolLecturer user school
 StudyFeatures
     user          UserId
     degree        StudyDegreeId
@@ -90,7 +90,7 @@ CourseParticipant
     courseId        CourseId
     userId          UserId
     registration    UTCTime
-    UniqueCourseParticipant courseId userId 
+    UniqueParticipant userId courseId
 Sheet
     courseId        CourseId
     name            Text

src/Foundation.hs

@@ -243,31 +243,27 @@ lecturerAccess school = do
     then Authorized
     else Unauthorized "No lecturer access"
 
+lecturerAccess' :: SchoolId -> YesodDB UniWorX AuthResult
+lecturerAccess' = authorizedFor UniqueSchoolLecturer MsgUnauthorizedSchoolLecturer
+-- Continue here
+
 courseLecturerAccess :: CourseId -> YesodDB UniWorX AuthResult
-courseLecturerAccess courseId = do
+courseLecturerAccess    = authorizedFor UniqueLecturer    MsgUnauthorizedLecturer
-  authId <- lift requireAuthId
-  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
+courseCorrectorAccess   = authorizedFor UniqueCorrector   MsgUnauthorizedCorrector
-  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
+courseParticipantAccess = authorizedFor UniqueParticipant MsgUnauthorizedParticipant
+
+authorizedFor :: (PersistEntityBackend record ~ BaseBackend backend, RenderMessage master msg, PersistEntity record, YesodAuth master, PersistUniqueRead backend)
+  => (AuthId master -> t -> Unique record) -> msg -> t -> ReaderT backend (HandlerT master IO) AuthResult
+authorizedFor authType msg courseId = do
   authId <- lift requireAuthId
-  participation <- getBy $ UniqueCourseParticipant courseId authId
+  access <- getBy $ authType authId courseId
-  return $ case participation of
+  case access of
-    (Just _) -> Authorized
+    (Just _) -> return Authorized
-    Nothing  -> Unauthorized "Not a participant for this course"
+    Nothing  -> unauthorizedI msg
-
-
 
 isAuthorizedDB' :: Route UniWorX -> Bool -> YesodDB UniWorX Bool
 isAuthorizedDB' route isWrite = (== Authorized) <$> isAuthorizedDB route isWrite

src/Handler/Course.hs

@@ -87,7 +87,7 @@ getCourseShowR tid csh = do
           <*> (case mbAid of -- TODO: Someone please refactor this late-night mess here!
                 Nothing -> return False
                 (Just aid) -> do
-                                regL <- getBy (UniqueCourseParticipant cid aid)
+                                regL <- getBy (UniqueParticipant aid cid)
                                 return $ isJust regL)
       return $ (courseEnt,dependent)
   let course = entityVal courseEnt  
@@ -115,13 +115,13 @@ postCourseShowR tid csh = do
   aid <- requireAuthId
   (cid, registered) <- runDB $ do
       (Entity cid _) <- getBy404 $ CourseTermShort tid csh
-      registered <- isJust <$> (getBy $ UniqueCourseParticipant cid aid)
+      registered <- isJust <$> (getBy $ UniqueParticipant aid cid)
       return (cid, registered)
   ((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerButton registered      
   case regResult of 
     (FormSuccess _)
       | registered -> do                    
-          runDB $ deleteBy $ UniqueCourseParticipant cid aid 
+          runDB $ deleteBy $ UniqueParticipant aid cid
           addMessage "info" "Sie wurden abgemeldet."          
       | otherwise  -> do
           actTime <- liftIO $ getCurrentTime