Provisional check for user adding themselves as lecturer

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.

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|
                   <div class="alert alert-danger">
@@ -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
         ]