feat(tutorials): delegate control to tutors

messages/uniworx/de.msg

@@ -412,6 +412,7 @@ UnknownAuthPredicate tag@String: Authorisierungsprädikat "#{tag}" ist dem Syste
 UnauthorizedRedirect: Die angeforderte Seite existiert nicht oder Sie haben keine Berechtigung, die angeforderte Seite zu sehen.
 UnauthorizedSelf: Aktueller Nutzer ist nicht angegebener Benutzer.
 UnauthorizedTutorialTutor: Sie sind nicht Tutor für dieses Tutorium.
+UnauthorizedTutorialTutorControl: Tutoren dürfen dieses Tutorium nicht editieren.
 UnauthorizedCourseTutor: Sie sind nicht Tutor für diesen Kurs.
 UnauthorizedTutor: Sie sind nicht Tutor.
 UnauthorizedTutorialRegisterGroup: Sie sind bereits in einem Tutorium mit derselben Registrierungs-Gruppe.
@@ -1126,6 +1127,7 @@ AuthTagDevelopment: Seite ist nicht in Entwicklung
 AuthTagLecturer: Nutzer ist Dozent
 AuthTagCorrector: Nutzer ist Korrektor
 AuthTagTutor: Nutzer ist Tutor
+AuthTagTutorControl: Tutoren haben Kontrolle über ihre Tutorium
 AuthTagTime: Zeitliche Einschränkungen sind erfüllt
 AuthTagStaffTime: Zeitliche Einschränkungen für Lehrbeteiligte sind erfüllt
 AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind erfüllt
@@ -1276,6 +1278,8 @@ TutorialDeregisterUntil: Abmeldungen bis
 TutorialsHeading: Tutorien
 TutorialEdit: Bearbeiten
 TutorialDelete: Löschen
+TutorialTutorControlled: Tutoren dürfen Tutorium editieren
+TutorialTutorControlledTip: Sollen Tutoren beliebige Aspekte dieses Tutoriums (Name, Registrierungs-Gruppe, Raum, Zeit, andere Tutoren, ...) beliebig editieren dürfen?
 
 CourseExams: Prüfungen
 CourseTutorials: Übungen

models/tutorials.model

@@ -10,6 +10,7 @@ Tutorial json
     registerTo      UTCTime Maybe
     deregisterUntil UTCTime Maybe
     lastChanged     UTCTime default=now()
+    tutorControlled Bool default=false
     UniqueTutorial course name
     deriving Generic
 Tutor

routes

@@ -158,12 +158,12 @@
   /tuts                         CTutorialListR GET             !tutor -- THIS route is used to check for overall course tutor access!
   /tuts/new                     CTutorialNewR  GET POST
   /tuts/#TutorialName TutorialR:
-    /edit                     TEditR           GET POST
+    /edit                     TEditR           GET POST        !tutorANDtutor-control
     /delete                   TDeleteR         GET POST
     /participants             TUsersR          GET POST        !tutor
     /register                 TRegisterR           POST        !timeANDcapacityANDcourse-registeredANDregister-group !timeANDtutorial-registered
     /communication            TCommR           GET POST        !tutor
-    /tutor-invite             TInviteR         GET POST
+    /tutor-invite             TInviteR         GET POST        !tutorANDtutor-control
   /exams                        CExamListR     GET             !free
   /exams/new                    CExamNewR      GET POST
   /exams/#ExamName ExamR:

src/Audit/Types.hs

@@ -132,6 +132,12 @@ data Transaction
     { transactionOffice :: UserId
     , transactionField :: StudyTermsId
     }
+  | TransactionTutorialEdit
+    { transactionTutorial :: TutorialId
+    }
+  | TransactionTutorialDelete
+    { transactionTutorial :: TutorialId
+    }
 
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 

src/Foundation.hs

@@ -799,6 +799,13 @@ tagAccessPredicate AuthTutor = APDB $ \mAuthId route _ -> exceptT return return
     _ -> do
       guardMExceptT (not $ Map.null resMap) (unauthorizedI MsgUnauthorizedTutor)
       return Authorized
+tagAccessPredicate AuthTutorControl = APDB $ \_ route _ -> case route of
+  CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgUnauthorizedTutorialTutorControl) $ do
+    Entity cid _ <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
+    Entity _ Tutorial{..} <- $cachedHereBinary (cid, tutn) . MaybeT . getBy $ UniqueTutorial cid tutn
+    guard tutorialTutorControlled
+    return Authorized
+  r -> $unsupportedAuthPredicate AuthTutorControl r
 tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of
   CApplicationR tid ssh csh _ _ -> maybeT (unauthorizedI MsgUnauthorizedApplicationTime) $ do
     course <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh

src/Handler/Info.hs

@@ -54,7 +54,7 @@ getInfoLecturerR =
     tooltipPlanned = [whamlet| _{MsgLecturerInfoTooltipPlanned} |]
     tooltipNewU2W  = [whamlet| _{MsgLecturerInfoTooltipNewU2W} |]
     newU2WFeat, probFeatInline, plannedFeat, plannedFeatInline :: WidgetFor UniWorX ()
-    newU2WFeat        = [whamlet| ^{iconTooltip tooltipNew (Just IconAnnounce) True} |]  -- to be used inside text blocks
+    newU2WFeat        = [whamlet| ^{iconTooltip tooltipNewU2W (Just IconAnnounce) True} |]  -- to be used inside text blocks
     probFeatInline    = [whamlet| ^{iconTooltip tooltipProblem (Just IconProblem) True} |]  -- to be used inside text blocks
     plannedFeat       = [whamlet| ^{iconTooltip tooltipPlanned (Just IconPlanned) False} |]
     plannedFeatInline = [whamlet| ^{iconTooltip tooltipPlanned (Just IconPlanned) True} |]  -- to be used inside text blocks
@@ -66,4 +66,4 @@ getInfoLecturerR =
       let expiryTime = UTCTime (addGregorianMonthsRollOver 1 $ fromGregorian year month day) 0
       if currentTime > expiryTime
         then mempty
-        else toWidget [whamlet| ^{iconTooltip tooltipNewU2W (Just IconNew) False} |]
+        else toWidget [whamlet| ^{iconTooltip tooltipNew (Just IconNew) False} |]

src/Handler/Tutorial/Delete.hs

@@ -35,5 +35,5 @@ postTDeleteR tid ssh csh tutn = do
     , drSuccessMessage = SomeMessage MsgTutorialDeleted
     , drAbort = SomeRoute $ CTutorialR tid ssh csh tutn TUsersR
     , drSuccess = SomeRoute $ CourseR tid ssh csh CTutorialListR
-    , drDelete = const id  -- TODO: audit
+    , drDelete = \tutid' act -> act <* audit (TransactionTutorialDelete tutid')
     }

src/Handler/Tutorial/Edit.hs

@@ -42,6 +42,7 @@ postTEditR tid ssh csh tutn = do
         , tfDeregisterUntil = tutorialDeregisterUntil
         , tfTutors          = Set.fromList (map Right tutorIds)
                            <> Set.mapMonotonic Left (Map.keysSet tutorInvites)
+        , tfTutorControlled = tutorialTutorControlled
         }
 
     return (cid, tutid, template)
@@ -63,8 +64,11 @@ postTEditR tid ssh csh tutn = do
         , tutorialRegisterTo      = tfRegisterTo
         , tutorialDeregisterUntil = tfDeregisterUntil
         , tutorialLastChanged     = now
+        , tutorialTutorControlled = tfTutorControlled
         }
       when (is _Nothing insertRes) $ do
+        audit $ TransactionTutorialEdit tutid
+  
         let (invites, adds) = partitionEithers $ Set.toList tfTutors
 
         deleteWhere [ TutorTutorial ==. tutid ]

src/Handler/Tutorial/Form.hs

@@ -18,10 +18,11 @@ import qualified Data.CaseInsensitive as CI
 data TutorialForm = TutorialForm
   { tfName            :: TutorialName
   , tfType            :: CI Text
+  , tfRegGroup        :: Maybe (CI Text)
+  , tfTutorControlled :: Bool
   , tfCapacity        :: Maybe Int
   , tfRoom            :: Text
   , tfTime            :: Occurrences
-  , tfRegGroup        :: Maybe (CI Text)
   , tfRegisterFrom    :: Maybe UTCTime
   , tfRegisterTo      :: Maybe UTCTime
   , tfDeregisterUntil :: Maybe UTCTime
@@ -66,10 +67,11 @@ tutorialForm cid template html = do
   flip (renderAForm FormStandard) html $ TutorialForm
     <$> areq (textField & cfStrip & cfCI) (fslpI MsgTutorialName (mr MsgTutorialName) & setTooltip MsgTutorialNameTip) (tfName <$> template)
     <*> areq (textField & cfStrip & cfCI & addDatalist tutTypeDatalist) (fslpI MsgTutorialType $ mr MsgTutorialType) (tfType <$> template)
+    <*> aopt (textField & cfStrip & cfCI) (fslI MsgTutorialRegGroup & setTooltip MsgTutorialRegGroupTip) ((tfRegGroup <$> template) <|> Just (Just "tutorial"))
+    <*> apopt checkBoxField (fslI MsgTutorialTutorControlled & setTooltip MsgTutorialTutorControlledTip) (tfTutorControlled <$> template)
     <*> aopt (natFieldI MsgTutorialCapacityNonPositive) (fslpI MsgTutorialCapacity (mr MsgTutorialCapacity) & setTooltip MsgTutorialCapacityTip) (tfCapacity <$> template)
     <*> areq textField (fslpI MsgTutorialRoom $ mr MsgTutorialRoomPlaceholder) (tfRoom <$> template)
     <*> occurrencesAForm ("occurrences" :: Text) (tfTime <$> template)
-    <*> aopt (textField & cfStrip & cfCI) (fslI MsgTutorialRegGroup & setTooltip MsgTutorialRegGroupTip) ((tfRegGroup <$> template) <|> Just (Just "tutorial"))
     <*> aopt utcTimeField   (fslpI MsgRegisterFrom (mr MsgDate)
                                & setTooltip MsgCourseRegisterFromTip
                             ) (tfRegisterFrom <$> template)

src/Handler/Tutorial/New.hs

@@ -35,8 +35,11 @@ postCTutorialNewR tid ssh csh = do
         , tutorialRegisterTo      = tfRegisterTo
         , tutorialDeregisterUntil = tfDeregisterUntil
         , tutorialLastChanged     = now
+        , tutorialTutorControlled = tfTutorControlled
         }
       whenIsJust insertRes $ \tutid -> do
+        audit $ TransactionTutorialEdit tutid
+        
         let (invites, adds) = partitionEithers $ Set.toList tfTutors
         insertMany_ $ map (Tutor tutid) adds
         sinkInvitationsF tutorInvitationConfig $ map (, tutid, (InvDBDataTutor, InvTokenDataTutor)) invites

src/Model/Types/Security.hs

@@ -43,6 +43,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä
   | AuthLecturer
   | AuthCorrector
   | AuthTutor
+  | AuthTutorControl
   | AuthExamOffice
   | AuthAllocationRegistered
   | AuthCourseRegistered

templates/i18n/changelog/de.hamlet

@@ -1,5 +1,11 @@
 $newline never
 <dl .deflist>
+  <dt .deflist__dt>
+    ^{formatGregorianW 2019 10 14}
+  <dd .deflist__dd>
+    <ul>
+      <li>Kontrolle über Einstellungen eines Tutoriums kann an Tutoren deligiert werden
+  
   <dt .deflist__dt>
     ^{formatGregorianW 2019 10 10}
   <dd .deflist__dd>

templates/i18n/info-lecturer/de.hamlet

@@ -254,7 +254,13 @@ $newline text
         Eine Tutoriumsgruppe kann beliebig viele Tutoren haben und ein Tutor kann beliebig viele Tutoriengruppen betreuen.
 
       <p>
-        Tutoren haben Zugriff auf die Namen und Studiendaten ihrer Tutoriums-Teilnehmer und können auch Mitteilungen an sie verschicken (analog zu Kursmitteilungen).
+        Tutoren haben Zugriff auf die Namen und Studiendaten ihrer Tutoriums-Teilnehmer, können Mitteilungen an sie verschicken (analog zu Kursmitteilungen) und Teilnehmer aus ihrem Tutorium entfernen.
+
+      <p>
+        ^{newFeat 2019 10 14} Optional kann den Tutoren volle Kontrolle über
+        ihre Tutorien überlassen werden (bis auf Löschen des Tutoriums), Tutoren
+        können dann insbesondere eigenständig den regulären Raum und die Zeit
+        ihres Tutoriums anpassen.
 
     <dt .deflist__dt> Anmeldung
     <dd .deflist__dd>
@@ -277,10 +283,9 @@ $newline text
       <p>
         Um die Anmeldung in beliebig viele Tutoriumsgruppen zuzulassen können alle Registrierungs-Gruppen leer gelassen werden.
     
-    <dt .deflist__dt> ^{plannedFeat} Nachmeldung
+    <dt .deflist__dt> ^{newFeat 2019 10 10} Nachmeldung
     <dt .deflist__dd>
-      <p>
+      Kursverwalter können über die Teilnehmerliste der Veranstaltung Kursteilnehmer in Tutorien einteilen.
-        Es gibt zur Zeit keine Möglichkeit für die Kursverwalter oder Tutoren, Teilnehmer zu einem Tutorium hinzuzufügen.
 
 
 <section id="exams">

test/Database.hs

@@ -716,6 +716,7 @@ fillDb = do
     , tutorialRegisterTo = Nothing
     , tutorialDeregisterUntil = Nothing
     , tutorialLastChanged = now
+    , tutorialTutorControlled = True
     }
   void . insert $ Tutor tut1 gkleen
   void . insert $ TutorialParticipant tut1 fhamann
@@ -734,6 +735,7 @@ fillDb = do
     , tutorialRegisterTo = Nothing
     , tutorialDeregisterUntil = Nothing
     , tutorialLastChanged = now
+    , tutorialTutorControlled = False
     }
   void . insert $ Tutor tut2 gkleen
   -- datenbanksysteme

test/ModelSpec.hs

@@ -70,6 +70,7 @@ instance Arbitrary Tutorial where
     <*> arbitrary
     <*> arbitrary
     <*> arbitrary
+    <*> arbitrary
   shrink = genericShrink
 
 instance Arbitrary User where