diff --git a/models/lms.model b/models/lms.model index 9f04a1792..ac2128e55 100644 --- a/models/lms.model +++ b/models/lms.model @@ -131,7 +131,7 @@ LmsUserlist LmsResult qualification QualificationId OnDeleteCascade OnUpdateCascade ident LmsIdent - success Day + success Day -- BEWARE: timezone is local as submitted by LMS timestamp UTCTime default=now() UniqueLmsResult qualification ident -- required by DBTable deriving Generic diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 08557753b..74e22651f 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -25,6 +25,7 @@ import qualified Database.Esqueleto.Utils as E import qualified Data.Set as Set +import qualified Data.Time.Zones as TZ import Handler.Utils.DateTime import Handler.Utils.LMS (randomLMSIdentBut, randomLMSpw, maxLmsUserIdentRetries) @@ -202,12 +203,12 @@ dispatchJobLmsResults qid = JobHandlerAtomic act E.&&. E.isNothing (luser E.^. LmsUserEnded) -- do not process closed learners return (quser, luser, lresult) now <- liftIO getCurrentTime + let locDay = localDay $ TZ.utcToLocalTimeTZ appTZ now forM_ results $ \(Entity quid QualificationUser{..}, Entity luid LmsUser{..}, Entity lrid LmsResult{..}) -> do -- three separate DB operations per result is not so nice. All within one transaction though. - let nowadayP1 = succ $ utctDay now -- add one day to account for time synch problems - lmsUserStartedDay = utctDay lmsUserStarted - saneDate = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil nowadayP1) - && qualificationUserLastRefresh <= lmsUserStartedDay + let lmsUserStartedDay = localDay $ TZ.utcToLocalTimeTZ appTZ lmsUserStarted + saneDate = lmsResultSuccess `inBetween` (lmsUserStartedDay, min qualificationUserValidUntil locDay) + && qualificationUserLastRefresh <= utctDay lmsUserStarted newStatus = LmsSuccess lmsResultSuccess newValidTo = addGregorianMonthsRollOver (toInteger renewalMonths) qualificationUserValidUntil -- renew from old validUntil onwards note <- if saneDate && isLmsSuccess newStatus diff --git a/src/Model/Types/Lms.hs b/src/Model/Types/Lms.hs index ea6c53345..db6f263ca 100644 --- a/src/Model/Types/Lms.hs +++ b/src/Model/Types/Lms.hs @@ -104,7 +104,7 @@ instance Csv.FromField LmsBool where | i == "1" = pure $ LmsBool True | otherwise = mempty --- | LMS interface requires day format not compliant with iso8601 +-- | LMS interface requires day format not compliant with iso8601; also LMS uses LOCAL TIMEZONE newtype LmsDay = LmsDay { lms2day :: Day } deriving (Eq, Ord, Read, Show, Generic)