diff --git a/messages/campus/de.msg b/messages/campus/de.msg index 7e8a58a7f..e80603d2b 100644 --- a/messages/campus/de.msg +++ b/messages/campus/de.msg @@ -1,4 +1,4 @@ -CampusNote: Campus-Kennung bitte inkl. Domain-Teil (@campus.lmu.de) angeben. +CampusIdentNote: Campus-Kennung bitte inkl. Domain-Teil (@campus.lmu.de) angeben. CampusIdent: Campus-Kennung CampusPassword: Passwort CampusSubmit: Abschicken \ No newline at end of file diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 8b271d82e..330ebb0e3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -64,11 +64,19 @@ SheetHintFrom: Hinweis ab SheetSolution: Lösung SheetSolutionFrom: Lösung ab SheetMarking: Hinweise für Korrektoren -SheetType: Bewertung +SheetName: Name +SheetDescription: Hinweise für Teilnehmer +SheetType: Bewertung +SheetGroup: Gruppenabgabe SheetVisibleFrom: Sichtbar ab +SheetVisibleFromTip: Ohne Datum wird das Blatt nie sichtbar, z.B. weil es noch nicht fertig ist SheetActiveFrom: Aktiv ab +SheetActiveFromTip: Abgabe und Download der Aufgabenstellung ist erst ab diesem Datum möglich SheetActiveTo: Abgabefrist +SheetHintFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen +SheetSolutionFromTip: Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen +SheetMarkingTip: Hinweise zur Korrektur, sichtbar nur für Korrektoren SheetErrVisibility: Sichtbarkeit muss vor Beginn der Abgabefrist liegen SheetErrDeadlineEarly: Ende der Abgabefrist muss nach deren Beginn liegen @@ -139,7 +147,8 @@ CorrectorsDefaulted: Korrektoren-Liste wurde aus bisherigen Übungsblättern die Users: Benutzer HomeHeading: Aktuelle Termine -LoginHeading: Login bitte mit "@campus.lmu.de" angeben +LoginHeading: Authentifizierung +LoginTitle: Authentifizierung ProfileHeading: Benutzerprofil und Einstellungen ProfileDataHeading: Gespeicherte Benutzerdaten ImpressumHeading: Impressum @@ -194,6 +203,7 @@ SubmissionUsers: Studenten RatingPoints: Punkte RatingFiles: Korrigierte Dateien PointsNotPositive: Punktzahl darf nicht negativ sein +RatingPointsDone: Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist FileTitle: Dateiname FileModified: Letzte Änderung @@ -207,6 +217,20 @@ RatingFilesUpdated: Korrigierte Dateien überschrieben CourseMembers: Teilnehmer CourseMembersCount num@Int64: #{display num} CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} +CourseName: Name +CourseDescription: Beschreibung +CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet +CourseHomepage: Homepage +CourseShorthand: Kürzel +CourseShorthandUnique: Muss innerhalb des Semesters eindeutig sein +CourseSemester: Semester +CourseSchool: Institut +CourseCapacity: Kapazität +CourseCapacityTip: Falls angegeben wird die Anzahl an Kursanmeldungen, die zugelassen werden, beschränkt +CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt +CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich +CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein +CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein NoTableContent: Kein Tabelleninhalt NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index 2152d55bf..e15418668 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -17,9 +17,10 @@ import Control.Lens import Utils.Form + data CampusLogin = CampusLogin { campusIdent, campusPassword :: Text } -data CampusMessage = MsgCampusNote +data CampusMessage = MsgCampusIdentNote | MsgCampusIdent | MsgCampusPassword | MsgCampusSubmit @@ -31,7 +32,7 @@ campusForm :: ( RenderMessage site FormMessage , Show (ButtonCssClass site) ) => AForm (HandlerT site IO) CampusLogin campusForm = CampusLogin - <$> areq textField (fslI MsgCampusIdent) Nothing + <$> areq textField (fslpI MsgCampusIdent "user.name@campus.lmu.de" & setTooltip MsgCampusIdentNote) Nothing <*> areq passwordField (fslI MsgCampusPassword) Nothing <* submitButton diff --git a/src/CryptoID.hs b/src/CryptoID.hs index 3b5efceec..c0739843f 100644 --- a/src/CryptoID.hs +++ b/src/CryptoID.hs @@ -55,6 +55,7 @@ instance (CI.FoldCase s, PathMultiPiece s) => PathMultiPiece (CI s) where decCryptoIDs [ ''SubmissionId , ''FileId , ''UserId + , ''CourseId ] instance {-# OVERLAPS #-} namespace ~ CryptoIDNamespace (CI FilePath) SubmissionId => PathPiece (E.CryptoID namespace (CI FilePath)) where diff --git a/src/Foundation.hs b/src/Foundation.hs index 1536188d9..5c1e72361 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1074,12 +1074,13 @@ instance YesodAuth UniWorX where redirectToReferer _ = True loginHandler = do - tp <- getRouteToParent - lift . authLayout $ do - master <- getYesod - let authPlugins' = authPlugins master - $logDebugS "Auth" $ "Enabled plugins: " <> Text.intercalate ", " (map apName authPlugins') - forM_ authPlugins' $ flip apLogin tp + toParent <- getRouteToParent + lift . defaultLayout $ do + plugins <- getsYesod authPlugins + $logDebugS "Auth" $ "Enabled plugins: " <> Text.intercalate ", " (map apName plugins) + + setTitleI MsgLoginTitle + $(widgetFile "login") authenticate creds@(Creds{..}) = runDB . fmap (either id id) . runExceptT $ do let (userPlugin, userIdent) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 3d2a61116..5eb62fc30 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -389,7 +389,7 @@ postCorrectionR tid csh shn cid = do let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) ((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,) - <$> aopt pointsField (fslpI MsgRatingPoints "Punktezahl" & setTooltip "Abgabe zählt als korrigiert, gdw. Punktezahl gesetzt ist") (Just $ submissionRatingPoints) + <$> aopt pointsField (fslpI MsgRatingPoints "Punktezahl" & setTooltip MsgRatingPointsDone) (Just $ submissionRatingPoints) <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment)) <* submitButton diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 38cfbe239..e84f9d63b 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} @@ -184,7 +184,7 @@ courseDeleteHandler = undefined courseEditHandler :: Bool -> Maybe (Entity Course) -> Handler Html courseEditHandler isGet course = do aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!! - ((result, formWidget), formEnctype) <- runFormPost $ newCourseForm $ courseToForm <$> course + ((result, formWidget), formEnctype) <- runFormPost . newCourseForm =<< for course courseToForm case result of (FormSuccess res@( CourseForm { cfCourseId = Nothing @@ -217,10 +217,11 @@ courseEditHandler isGet course = do addMessageI "danger" $ MsgCourseNewDupShort tid csh (FormSuccess res@( - CourseForm { cfCourseId = Just cid + CourseForm { cfCourseId = Just cID , cfShort = csh , cfTerm = tid })) -> do -- edit existing course + cid <- decrypt cID now <- liftIO getCurrentTime -- addMessage "debug" [shamlet| #{show res}|] runDB $ do @@ -263,7 +264,7 @@ courseEditHandler isGet course = do data CourseForm = CourseForm - { cfCourseId :: Maybe CourseId -- Maybe CryptoUUIDCourse + { cfCourseId :: Maybe CryptoUUIDCourse , cfName :: CourseName , cfDesc :: Maybe Html , cfLink :: Maybe Text @@ -278,24 +279,24 @@ data CourseForm = CourseForm , cfDeRegUntil :: Maybe UTCTime } -courseToForm :: Entity Course -> CourseForm -courseToForm cEntity = CourseForm - { cfCourseId = Just $ entityKey cEntity - , cfName = courseName course - , cfDesc = courseDescription course - , cfLink = courseLinkExternal course - , cfShort = courseShorthand course - , cfTerm = courseTerm course - , cfSchool = courseSchool course - , cfCapacity = courseCapacity course - , cfSecret = courseRegisterSecret course - , cfMatFree = courseMaterialFree course - , cfRegFrom = courseRegisterFrom course - , cfRegTo = courseRegisterTo course - , cfDeRegUntil = courseDeregisterUntil course - } - where - course = entityVal cEntity +courseToForm :: MonadCrypto m => Entity Course -> m CourseForm +courseToForm (Entity cid Course{..}) = do + cfCourseId <- Just <$> encrypt cid + return $ CourseForm + { cfCourseId + , cfName = courseName + , cfDesc = courseDescription + , cfLink = courseLinkExternal + , cfShort = courseShorthand + , cfTerm = courseTerm + , cfSchool = courseSchool + , cfCapacity = courseCapacity + , cfSecret = courseRegisterSecret + , cfMatFree = courseMaterialFree + , cfRegFrom = courseRegisterFrom + , cfRegTo = courseRegisterTo + , cfDeRegUntil = courseDeregisterUntil + } newCourseForm :: Maybe CourseForm -> Form CourseForm newCourseForm template = identForm FIDcourse $ \html -> do @@ -306,29 +307,32 @@ newCourseForm template = identForm FIDcourse $ \html -> do -- UUID.encrypt cidKey cid (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm -- <$> pure cid -- $ join $ cfCourseId <$> template -- why doesnt this work? - <$> aopt hiddenField "KursId" (cfCourseId <$> template) - <*> areq (ciField textField) (fsb "Name") (cfName <$> template) - <*> aopt htmlField (fsb "Beschreibung") (cfDesc <$> template) - <*> aopt urlField (fsb "Homepage") (cfLink <$> template) - <*> areq (ciField textField) (fsb "Kürzel" + <$> aopt hiddenField "courseId" (cfCourseId <$> template) + <*> areq (ciField textField) (fslI MsgCourseName) (cfName <$> template) + <*> aopt htmlField (fslI MsgCourseDescription + & setTooltip MsgCourseDescriptionTip) (cfDesc <$> template) + <*> aopt urlField (fslI MsgCourseHomepage) (cfLink <$> template) + <*> areq (ciField textField) (fslI MsgCourseShorthand -- & addAttr "disabled" "disabled" - & setTooltip "Muss innerhalb des Semesters eindeutig sein") + & setTooltip MsgCourseShorthandUnique) (cfShort <$> template) - <*> areq termActiveField (fsb "Semester") (cfTerm <$> template) - <*> areq schoolField (fsb "Institut") (cfSchool <$> template) - <*> aopt (natField "Kapazität") (fsb "Kapazität") (cfCapacity <$> template) + <*> areq termActiveField (fslI MsgCourseSemester) (cfTerm <$> template) + <*> areq schoolField (fslI MsgCourseSchool) (cfSchool <$> template) + <*> aopt (natField "Kapazität") (fslI MsgCourseCapacity + & setTooltip MsgCourseCapacityTip + ) (cfCapacity <$> template) <*> aopt textField (fslpI MsgCourseSecret "beliebige Zeichenkette" - & setTooltip "Optional: Anmeldung zum Kurs benötigt ein Passwort") + & setTooltip MsgCourseSecretTip) (cfSecret <$> template) <*> areq checkBoxField (fslI MsgMaterialFree)(cfMatFree <$> template) - <*> aopt utcTimeField (fslpI MsgRegisterFrom "Datum, sonst KEINE Anmeldung" - & setTooltip "Ohne Datum ist keine Anmeldung zu diesem Kurs möglich!") + <*> aopt utcTimeField (fslpI MsgRegisterFrom "Datum" + & setTooltip MsgCourseRegisterFromTip) (cfRegFrom <$> template) - <*> aopt utcTimeField (fslpI MsgRegisterTo "Datum, sonst unbegr. Anmeldung" - & setTooltip "Die Anmeldung darf ohne Begrenzung sein") + <*> aopt utcTimeField (fslpI MsgRegisterTo "Datum" + & setTooltip MsgCourseRegisterToTip) (cfRegTo <$> template) - <*> aopt utcTimeField (fslpI MsgDeRegUntil "Datum, sonst unbegr. Abmeldung" - & setTooltip "Die Abmeldung darf ohne Begrenzung sein") + <*> aopt utcTimeField (fslpI MsgDeRegUntil "Datum" + & setTooltip MsgCourseDeregisterUntilTip) (cfDeRegUntil <$> template) <* submitButton return $ case result of diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 64cc2a6b2..462afdf25 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -104,29 +104,29 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do mr <- getMsgRenderer ctime <- liftIO $ getCurrentTime (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm - <$> areq (ciField textField) (fsb "Name") (sfName <$> template) - <*> aopt htmlField (fsb "Hinweise für Teilnehmer") (sfDescription <$> template) - <*> sheetTypeAFormReq (fsb "Bewertung") (sfType <$> template) - <*> sheetGroupAFormReq (fsb "Abgabegruppengröße") (sfGrouping <$> template) - <*> aopt htmlField (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template) + <$> areq (ciField textField) (fslI MsgSheetName) (sfName <$> template) + <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) + <*> sheetTypeAFormReq (fslI MsgSheetType) (sfType <$> template) + <*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template) + <*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template) <*> aopt utcTimeField (fslI MsgSheetVisibleFrom - & setTooltip "Ohne Datum ist das Blatt komplett unsichtbar, z.B. weil es noch nicht fertig ist.") + & setTooltip MsgSheetVisibleFromTip) ((sfVisibleFrom <$> template) <|> pure (Just ctime)) <*> areq utcTimeField (fslI MsgSheetActiveFrom - & setTooltip "Abgabe und Dateien zur Aufgabenstellung sind erst ab diesem Datum zugänglich") + & setTooltip MsgSheetActiveFromTip) (sfActiveFrom <$> template) <*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template) - <*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template) + <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template) <*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren" - & setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen") + & setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template) <*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template) <*> aopt utcTimeField (fslpI MsgSheetSolutionFrom "Datum, sonst nur für Korrektoren" - & setTooltip "Ohne Datum nie für Teilnehmer sichtbar, Korrektoren können diese Dateien immer herunterladen") + & setTooltip MsgSheetSolutionFromTip) (sfSolutionFrom <$> template) <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template) <*> aopt (multiFileField $ oldFileIds SheetMarking) (fslI MsgSheetMarking - & setTooltip "Hinweise zur Korrektur, sichtbar nur für Korrektoren") (sfMarkingF <$> template) + & setTooltip MsgSheetMarkingTip) (sfMarkingF <$> template) <* submitButton return $ case result of FormSuccess sheetResult diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index b5d9fecac..208d42caf 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -115,11 +115,9 @@ setClass fs c = fs { fsAttrs=("class",c):(fsAttrs fs) } setNameClass :: FieldSettings site -> Text -> Text -> FieldSettings site -- deprecated setNameClass fs gName gClass = fs { fsName= Just gName, fsAttrs=("class",gClass):(fsAttrs fs) } -setTooltip :: String -> FieldSettings site -> FieldSettings site -setTooltip tt fs - | null tt = fs { fsTooltip = Nothing } - | otherwise = fs { fsTooltip = Just $ fromString tt - , fsAttrs=("data-tooltip",fromString tt):(fsAttrs fs) } +setTooltip :: RenderMessage site msg => msg -> FieldSettings site -> FieldSettings site +setTooltip msg fs = fs { fsTooltip = Just $ SomeMessage msg } + ------------------------------------------------ -- Unique Form Identifiers to avoid accidents -- ------------------------------------------------ @@ -190,4 +188,3 @@ combinedButtonField btns = traverse b2f btns submitButton :: (Button site SubmitButton, Show (ButtonCssClass site)) => AForm (HandlerT site IO) () submitButton = void $ combinedButtonField [BtnSubmit] - diff --git a/templates/login.hamlet b/templates/login.hamlet new file mode 100644 index 000000000..6056528d0 --- /dev/null +++ b/templates/login.hamlet @@ -0,0 +1,7 @@ +$forall AuthPlugin{..} <- plugins +
+ $if apName == "LDAP" +

Campus-Kennung + $if apName == "dummy" +

Dummy + ^{apLogin toParent} diff --git a/templates/widgets/form.hamlet b/templates/widgets/form.hamlet index c59a21d32..a28adabf4 100644 --- a/templates/widgets/form.hamlet +++ b/templates/widgets/form.hamlet @@ -8,3 +8,7 @@ $case formLayout