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
]