diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index b82d83a28..a2e0e49e3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -104,6 +104,9 @@ CourseLecturers: Kursverwalter CourseLecturer: Dozent CourseAssistant: Assistent CourseLecturerAlreadyAdded email@UserEmail: Es gibt bereits einen Kursverwalter mit E-Mail #{email} +CourseRegistrationEndMustBeAfterStart: Ende des Anmeldezeitraums muss nach dem Anfang liegen +CourseDeregistrationEndMustBeAfterStart: Ende des Abmeldezeitraums muss nach dem Anfang des Anmeldezeitraums liegen +CourseUserMustBeLecturer: Aktueller Benutzer muss als Kursverwalter eingetragen sein NoSuchTerm tid@TermId: Semester #{display tid} gibt es nicht. NoSuchSchool ssh@SchoolId: Institut #{display ssh} gibt es nicht. diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index ad59f17bb..3f4900171 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -14,7 +14,7 @@ import Handler.Utils.Delete import Handler.Utils.Database import Handler.Utils.Table.Cells import Handler.Utils.Table.Columns -import Database.Esqueleto.Utils +import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH -- import Data.Time @@ -684,10 +684,10 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do <*> aopt utcTimeField (fslpI MsgDeRegUntil (mr MsgDate) & setTooltip MsgCourseDeregisterUntilTip) (deepAlt (cfDeRegUntil <$> template) newDeRegUntil) <*> lecturerForm - return $ case result of - FormSuccess courseResult - | errorMsgs <- validateCourse courseResult - , not $ null errorMsgs -> + errorMsgs' <- traverse validateCourse result + return $ case errorMsgs' of + FormSuccess errorMsgs + | not $ null errorMsgs -> (FormFailure errorMsgs, [whamlet|
@@ -702,23 +702,26 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse $ \html -> do _ -> (result, widget) -validateCourse :: CourseForm -> [Text] -validateCourse CourseForm{..} = - [ msg | (False, msg) <- - [ - ( NTop cfRegFrom <= NTop cfRegTo - , "Ende des Anmeldezeitraums muss nach dem Anfang liegen" - ) - , - ( NTop cfRegFrom <= NTop cfDeRegUntil - , "Ende des Abmeldezeitraums muss nach dem Anfang liegen" - ) --- No starting date is okay: effective immediately --- ( cfHasReg <= (isNothing cfRegFrom) --- , "Beginn der Anmeldung angeben oder Anmeldungen deaktivieren" --- ) --- , - ] ] +validateCourse :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseForm -> m [Text] +validateCourse CourseForm{..} = do + uid <- liftHandlerT requireAuthId + userAdmin <- liftHandlerT . runDB . getBy $ UniqueUserAdmin uid cfSchool -- FIXME: This /needs/ to be a call to `isAuthorized` on a route + MsgRenderer mr <- getMsgRenderer + + return + [ mr msg | (False, msg) <- + [ + ( NTop cfRegFrom <= NTop cfRegTo + , MsgCourseRegistrationEndMustBeAfterStart + ) + , + ( NTop cfRegFrom <= NTop cfDeRegUntil + , MsgCourseDeregistrationEndMustBeAfterStart + ) + , ( maybe (any ((== uid) . fst) cfLecturers) (\(Entity _ UserAdmin{}) -> True) userAdmin + , MsgCourseUserMustBeLecturer + ) + ] ] @@ -852,7 +855,7 @@ makeCourseUserTable cid colChoices psValidator = , fltrUserNameEmail queryUser -- , ("course-user-degree", error "TODO") -- TODO -- , ("course-user-field" , error "TODO") -- TODO - , ("course-user-semesternr", FilterColumn $ mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) + , ("course-user-semesternr", FilterColumn $ E.mkExactFilter $ queryFeaturesStudy >>> (E.?. StudyFeaturesSemester)) -- , ("course-registration", error "TODO") -- TODO -- , ("course-user-note", error "TODO") -- TODO ]