Fixes #190

src/Handler/Course.hs

@@ -532,12 +532,17 @@ newCourseForm template = identForm FIDcourse $ \html -> do
         [ map (userLecturerSchool . entityVal) <$> selectList [UserLecturerUser ==. userId] []
         , map (userAdminSchool    . entityVal) <$> selectList [UserAdminUser    ==. userId] []
         ]
-    let termsField = case template of
+
-          --TODO: if Admin, then all
+    termsField <- liftHandlerT $ case template of
-          -- if allowed to delete course then allow current and all active term
+          -- Change of term is only allowed if user may delete the course (i.e. no participants) or admin
-          -- otherwise only keep current term
+          (Just cform)  | (Just cid) <- cfCourseId cform -> do -- edit existing course
-          (Just cform) | (Just _) <- cfCourseId cform -> termsSetField [cfTerm cform]
+              _courseOld@Course{..} <- runDB $ get404 cid
-          _allOtherCases -> termsActiveField
+              mayEditTerm <- isAuthorized TermEditR True
+              mayDelete   <- isAuthorized (CourseR courseTerm courseSchool courseShorthand CDeleteR) True
+              return $ if
+                | (mayEditTerm == Authorized) || (mayDelete == Authorized) -> termsAllowedField
+                | otherwise ->  termsSetField [cfTerm cform]
+          _allOtherCases -> return termsAllowedField
     (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
       <$> pure (cfCourseId =<< template)
       <*> areq ciField (fslI MsgCourseName)          (cfName     <$> template)

src/Handler/Utils/Form.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE LambdaCase #-}
@@ -220,6 +221,13 @@ pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..}
 termsActiveField :: Field Handler TermId
 termsActiveField = selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName
 
+termsAllowedField :: Field Handler TermId
+termsAllowedField = selectField $ do
+  mayEditTerm <- isAuthorized TermEditR True
+  let termFilter | Authorized <- mayEditTerm = []
+                 | otherwise = [TermActive ==. True]
+  optionsPersistKey termFilter [Desc TermStart] termName
+
 termsSetField :: [TermId] -> Field Handler TermId
 termsSetField tids = selectField $ optionsPersistKey [TermName <-. (unTermKey <$> tids)] [Desc TermStart] termName
 -- termsSetField tids = selectFieldList [(unTermKey t, t)| t <- tids ]