diff --git a/messages/uniworx/categories/term/de-de-formal.msg b/messages/uniworx/categories/term/de-de-formal.msg index d88a9600f..f235804ea 100644 --- a/messages/uniworx/categories/term/de-de-formal.msg +++ b/messages/uniworx/categories/term/de-de-formal.msg @@ -5,24 +5,23 @@ TermStartMustBeBeforeLectureStart: Semester muss vor der Vorlesungszeit beginnen TermEndMustBeAfterLectureEnd: Vorlesungszeit muss vor dem Semester enden. TermShort: Kürzel TermCourseCount: Kurse -TermStart: Semesteranfang -TermEnd: Semesterende -LectureStart: Beginn Vorlesungen +TermStart: Anfang Kursperiode +TermEnd: Ende Kursperiode +LectureStart: Beginn Kurse TermEdited tid@TermId: Semester #{tid} erfolgreich editiert. TermNewTitle: Semester editieren/anlegen. InvalidInput: Eingaben bitte korrigieren. Term !ident-ok: Semester TermPlaceholder: JJJJ-MM-TT (Erster Tag einer Schulung) TermStartDay: Erster Tag -TermStartDayTooltip: Üblicherweise immer 1. April oder 1. Oktober TermEndDay: Letzter Tag -TermEndDayTooltip: Üblicherweise immer 30. September oder 31. März TermHolidays: Feiertage TermHolidayPlaceholder: Feiertag TermHolidayMissing: Feiertag wird benötigt TermLectureStart: Beginn Vorlesungen TermLectureEnd: Ende Vorlesungen -TermLectureEndTooltip: Meistens dauer das Sommersemester 14 Wochen und das Wintersemester 15 Wochen. +TermLectureStartTooltip: Muss am oder nach dem Beginn liegen +TermLectureEndTooltip: Muss am oder vor dem Ende liegen TermActive: Aktiv NumCourses num@Int64: #{num} #{pluralDE num "Kurs" "Kurse"} TermsHeading: Semesterübersicht diff --git a/messages/uniworx/categories/term/en-eu.msg b/messages/uniworx/categories/term/en-eu.msg index 8f2218f58..d27a2ecf1 100644 --- a/messages/uniworx/categories/term/en-eu.msg +++ b/messages/uniworx/categories/term/en-eu.msg @@ -5,24 +5,23 @@ TermStartMustBeBeforeLectureStart: Semester start must be before lecture start. TermEndMustBeAfterLectureEnd: Lecture end must be before semester end. TermShort: Shorthand TermCourseCount: Courses -TermStart: Semester start -TermEnd: Semester end -LectureStart: Lectures start +TermStart: Start of teaching period +TermEnd: End of teaching perios +LectureStart: Courses start TermEdited tid: Successfully edited semester #{tid} TermNewTitle: Edit/create semester InvalidInput: Invalid input Term: Semester TermPlaceholder: YYYY-MM-DD (First day of courses) TermStartDay: Starting day -TermStartDayTooltip: Usually 1st of April or 1st of October TermEndDay: Last day -TermEndDayTooltip: Usually 30th of September or 31st of March TermHolidays: Legal holidays TermHolidayPlaceholder: Legal holiday TermHolidayMissing: Holiday is required TermLectureStart: Lectures start TermLectureEnd: Lectures end -TermLectureEndTooltip: Summer semesters are usually 14 weeks; winter semesters 15 +TermLectureStartTooltip: Must be on or after starting day +TermLectureEndTooltip: Must be before or on ending day TermActive: Active NumCourses num: #{num} #{pluralEN num "course" "courses"} TermsHeading: Semesters diff --git a/models/lms.model b/models/lms.model index e6923fa17..ffbfa3348 100644 --- a/models/lms.model +++ b/models/lms.model @@ -21,13 +21,14 @@ Qualification -- A: Es kann gleich eine LMS Pin generiert und verschickt werden! -- - Aufteilung Qualification "R" in zwei Teile: "R e-learning" und "R praxis" okay? --- Fragen an Know-How: --- - Bedeutung LMS Übermittlung interner Mitarbeiter? --- - LmsUser shall submit DELTA only: Beware, GET Request will always return the same; until POST Request was processed! --- - Success/Failure: is an explicit LMS-delete still necessary? --- - User: pin reset = 1 to existing pin problematic? Resubmission of existing users with pin causes which problems? --- - ident unique for all qualifications F/R or duplicated? (F/R refreshers might be simultaneous) --- - Anzahl Fehlversuche: wird pro Durchfallen ein Failed gemeldet oder nur einmal? +-- Besonderheiten: +-- - LmsIdent muss für alle Qualificationen einzigartig sein! +-- - Durchfallen wird mit UserList ständig erneut gesandt, bis Löschantrag gestellt wurde. +-- - Bestehen mit Result wird nur ein einziges mal gesendet! (Ausfallrisiko: keine Bestätigung der Kommunikation!) +-- - Explizites Löschen eines LmsIdent nach Success/Failure ist notwendig (feedback bei Block) +-- - LmsUser soll nur DELTA übermitteln. (GET Request will always return the same; until POST Request was processed!) +-- - PinReset==1 mit bestehendem Passwort kann problemlos erneut gesendet werden +-- - Flag "interner Mitarbeiter" wird von Know-How ignoriert / nicht ausgewertet (legacy) QualificationPrecondition qualification QualificationId -- AND: not unique, ie. qualification can have multiple required preconditions @@ -46,7 +47,7 @@ QualificationEdit QualificationUser user UserId qualification QualificationId OnDeleteCascade OnUpdateCascade - validUntil UTCTime + validUntil UTCTime --TODO convert to DAYS only! lastRefresh UTCTime -- lastRefresh > validUntil possible, if Qualification^elearningOnly == False firstHeld UTCTime -- first time the qualification was earned, should never change -- temporärer Entzug vorsehen @@ -95,6 +96,7 @@ LmsUser started UTCTime default=now() received UTCTime Maybe -- last acknowledgement by LMS ended UTCTime Maybe -- ident was deleted from LMS + -- Primary ident -- newtype Key LmsUserId = LmsUserKey { unLmsUser :: Text } -- change LmsIdent -> Text. Do we want this? UniqueLmsUser ident -- idents must be unique accross all qualifications, since idents are global within LMS! deriving Generic diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 03b52a21f..c5e655a8a 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -354,11 +354,11 @@ newTermForm mtid template = validateForm validateTerm $ \html -> do fRequired = False flip (renderAForm FormStandard) html $ TermForm <$> tidForm - <*> areq dayField (fslI MsgTermStartDay & setTooltip MsgTermStartDayTooltip) (tftStart template) - <*> areq dayField (fslI MsgTermEndDay & setTooltip MsgTermEndDayTooltip) (tftEnd template) + <*> areq dayField (fslI MsgTermStartDay) (tftStart template) + <*> areq dayField (fslI MsgTermEndDay ) (tftEnd template) <*> (ungroupHolidays <$> holidayForm (groupHolidays <$> tftHolidays template)) - <*> areq dayField (fslI MsgTermLectureStart) (tftLectureStart template) - <*> areq dayField (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template) + <*> areq dayField (fslI MsgTermLectureStart & setTooltip MsgTermLectureStartTooltip) (tftLectureStart template) + <*> areq dayField (fslI MsgTermLectureEnd & setTooltip MsgTermLectureEndTooltip) (tftLectureEnd template) <*> activeForm (tftActive template) diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index edcfbdc42..2ce9a0a02 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -12,7 +12,7 @@ module Handler.Utils.DateTime , getTimeLocale, getDateTimeFormat , getDateTimeFormatter , validDateTimeFormats, dateTimeFormatOptions - , addLocalDays + , addLocalDays, addDiffDays , addOneWeek, addWeeks , weeksToAdd , setYear, getYear @@ -249,6 +249,10 @@ addLocalDays n utct = localTimeToUTCTZ appTZ newLocal newDay = addDays n oldDay newLocal = oldLocal { localDay = newDay } +addDiffDays :: CalendarDiffDays -> UTCTime -> UTCTime +addDiffDays = over _utctDay . addGregorianDurationClip + + weeksToAdd :: UTCTime -> UTCTime -> Integer -- ^ Number of weeks needed to add so that first -- time occurs later than second time diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 6f5cd11fa..952d3e978 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -1,7 +1,9 @@ {-# LANGUAGE TypeApplications #-} module Jobs.Handler.LMS - ( dispatchJobLmsResults + ( dispatchJobLmsEnqueue + , dispatchJobLmsDequeue + , dispatchJobLmsResults , dispatchJobLmsUserlist ) where @@ -13,6 +15,47 @@ import qualified Database.Esqueleto.Experimental as E -- import qualified Database.Esqueleto.PostgreSQL as E -- for insertSelect variant import qualified Database.Esqueleto.Utils as E +import Handler.Utils.DateTime (addDiffDays) + +dispatchJobLmsEnqueue :: QualificationId -> JobHandler UniWorX +dispatchJobLmsEnqueue qid = JobHandlerAtomic act + where + -- act :: YesodJobDB UniWorX () + act = hoist lift $ do + now <- liftIO getCurrentTime + Just (Entity _ quali) <- E.selectOne $ E.from $ \quali -> E.where_ (quali E.^. QualificationId E.==. E.val qid) >> pure quali + -- Just quali <- get qid + let Just refreshTime = qualificationRefreshWithin quali -- HACK / TODO + freshIdent = LmsIdent "abcd" -- TODO + freshPin = "1234" -- TODO + cutoff = addDiffDays refreshTime now + res <- E.insertSelect $ do + quser <- from (E.table @QualificationUser) + E.where_ ( quser E.^. QualificationUserQualification E.==. E.val qid + E.&&. quser E.^. QualificationUserValidUntil E.>=. E.val now + E.&&. quser E.^. QualificationUserValidUntil E.<=. E.val cutoff + ) + -- and not exists already as LMS User + return $ LmsUser + E.<# E.val qid + E.<&> (quser E.^. QualificationUserUser) + E.<&> E.val freshIdent -- ident -- THIS IS A PROBLEM! MUST ALSO BE UNIQUE! + E.<&> E.val freshPin -- pin -- THIS IS A PROBLEM! + E.<&> E.false -- reset + E.<&> E.nothing -- status + E.<&> E.val now -- started + E.<&> E.nothing -- received + E.<&> E.nothing -- ended + + -- find qualification holders + error "lms dequeu stub" + +dispatchJobLmsDequeue :: QualificationId -> JobHandler UniWorX +dispatchJobLmsDequeue qid = + -- wenn bestanden: qualification verlängern & LmsIdent löschen + -- wenn durchgefallen: LmsIdent löschen + -- wenn Zeit abgelaufen: LmsIdent löschen + error "lms dequeu stub" dispatchJobLmsResults :: QualificationId -> JobHandler UniWorX dispatchJobLmsResults qid = JobHandlerAtomic act diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 315f5f82d..e971bfee9 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -105,6 +105,8 @@ data Job , jEpoch , jIteration :: Natural } + | JobLmsEnqueue { jQualification :: QualificationId } + | JobLmsDequeue { jQualification :: QualificationId } | JobLmsUserlist { jQualification :: QualificationId } | JobLmsResults { jQualification :: QualificationId } deriving (Eq, Ord, Show, Read, Generic, Typeable) diff --git a/src/Model/Types/DateTime.hs b/src/Model/Types/DateTime.hs index 1d54bb162..065a38f08 100644 --- a/src/Model/Types/DateTime.hs +++ b/src/Model/Types/DateTime.hs @@ -71,12 +71,14 @@ shortened = iso shorten expand -- Handler.Utils.Widget.tidFromText -- MsgTermPlaceHolder termToText :: TermIdentifier -> Text -termToText TermIdentifier{..} = Text.pack . show $ year ^. shortened +termToText TermIdentifier{..} = Text.pack . show $ year -- ^. shortened termFromText :: Text -> Either Text TermIdentifier termFromText t - | Just (review shortened -> year) <- readMaybe $ Text.unpack t + | Just year <- readMaybe $ Text.unpack t = Right TermIdentifier {..} + -- | Just (review shortened -> year) <- readMaybe $ Text.unpack t + -- = Right TermIdentifier {..} | otherwise = Left $ "Invalid TermIdentifier: “" <> t <> "”; expected is just a year number." diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs index 74d13b545..c1a2e509f 100644 --- a/test/Model/TypesSpec.hs +++ b/test/Model/TypesSpec.hs @@ -46,7 +46,6 @@ import qualified Data.Text.Lazy as LT import Text.Blaze.Html.Renderer.Text (renderHtml) -import Handler.Utils.DateTime (getYear) {- instance Arbitrary Day where @@ -65,7 +64,7 @@ instance CoArbitrary Day where instance Arbitrary TermIdentifier where arbitrary = TermIdentifier <$> arbitrary - shrink = fmap TermIdentifier . shrink . getTermDay + shrink = fmap TermIdentifier . shrink . year instance CoArbitrary TermIdentifier instance Function TermIdentifier @@ -471,7 +470,7 @@ spec = do --it "has compatible encoding/decoding to/from PersistValue" . property $ -- \term -> fromPersistValue (toPersistValue term) == term it "has human readable year encoding to Rational" . property $ - \term -> truncate (termToRational term) == getYear (getTermDay term) + \term -> truncate (termToRational term) == year term describe "Pseudonym" $ do it "has sufficient vocabulary" $ (length pseudonymWordlist ^ 2) `shouldSatisfy` (> (fromIntegral (maxBound :: Pseudonym) - fromIntegral (minBound :: Pseudonym)))